home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
node2src.zip
/
RBBSSUB3.BAS
< prev
next >
Wrap
BASIC Source File
|
1990-12-31
|
114KB
|
3,077 lines
' $linesize:132
' $title: 'RBBSSUB3.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
' Copyright 1990 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB3.BAS
' First Released .....: February 4, 1990
' Subsequent Releases.:
' Copyright ..........: 1986 - 1990
' Purpose.............: The Remote Bulletin Board System for the IBM PC,
' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not
' require error trapping are incorporated within RBBSSUB 2-5 as
' separately callable subroutines in order to free up as much
' code as possible within the 64K code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' AllCaps 58050 Convert a string to all upper case characters
' AMorPM 41498 Calculate the current time as AM or PM
' AskGraphics 43004 Determine users graphic default
' BadFile 20741 Check for system crash attempt with bad device name
' Carrier 42000 Test for whether to continue in RBBS
' CheckTime 58070 Test to insure that users don't exceed their time
' CheckCarrier 42005 Checks whether still have carrier
' CheckNewBul 58110 Check for new bulletins based on their file creation date
' CheckTimeRemain 41008 Set up to log off if time exceeded
' CommInfo 44020 Get users baud rate and parity in a string format
' CountLines 58160 Count categories a file can be classified into
' CountNewFiles 58150 Check for number of files uploaded after a specific date
' DelayTime 50495 Wait number of seconds specified before returning
' DispCall 57001 Display callers file
' DispTimeRemain 41032 Compute and display time remaining
' DispUpDir 58165 Display the shared directory of the FMS mng. sys.
' FileLock 21993 Moved to RBBSSUB1 for Error Traping 'Pe 02/04/90
' FindFKey 30595 Handle local keyboard's function & ZSysop's keys
' FindLast 58600 Finds last occurence of a string in a string
' FlushKeys 35000 Completely flush all user input
' Graphic 43031 Determines if graphic ver of file exists, opens as #2
' GraphicX 43031 Determines if graphic ver of file exists, any file #
' HashRBBS 58080 "Hash" to a user's record in the USERS file
' InitFMS 58162 Initialize the RBBS-PC's File Management System
' InitIBM 30000 Open/create NetBIOS semaphore file
' AddCommas 58130 Format commands in the command prompt
' Library 21105 Provide support for "library" drives
' LinesInFile 58161 Counts lines in a file
' LoadNew 58140 Find the latest uploads
' ModemPut 52070 Write a modem command string to the modem
' NameCaps 58060 Convert a string to Proper Case (for name output)
' OpenMsg 30500 Open the messages file as file number 1
' PageUp 33202 Display user info. on local screen for ZSysop
' ReadProf 44000 Read user's profile on return from a "door"
' SaveProf 43068 Save the user's provile when exiting to "doors" or DOS
' SendName 20293 Send filename via EXEC-PC protocol during autodownload
' SetOpts 58100 Set correct prompt line for each subsystem
' SortString 58120 Sort characters in a string
' TestUser 20310 Check if user's software can do auto downloading
' TimeRemain 41010 Compute time remaining in minutes
' UpdtUpload 20705 Updates upload directory file
' WildFile 20290 Determines whether string matches a pattern
' XferType 21600 Identify the file transfer protocol
'
' $INCLUDE: 'RBBS-VAR.BAS'
'
20290 ' $SUBTITLE: 'WildFile -- Matches file to a filespec'
' $PAGE
' NAME -- WildFile
'
' INPUTS -- PARAMETER MEANING
' Pattern$ PATTERN TO CHECK AGAINST
' ItemToMatch$ FILE NAME TO MATCH
'
' OUTPUTS -- DoesMatch WHETHER MATCHES
'
' PURPOSE Determine whether a file name is an instance of
' a file specification. Exactly like DOS except that ? must have a
' character.
'
SUB WildFile (Pattern$,ItemToMatch$,DoesMatch) STATIC
IF Pattern$ <> PrevPattern$ THEN _
CALL BreakFileName (Pattern$,PDrive$,PPrefix$,PExt$,ZFalse) : _
PrevPattern$ = Pattern$
CALL BreakFileName (ItemToMatch$,IDrive$,IPrefix$,IExt$,ZFalse)
DoesMatch = ZFalse
IF PDrive$ <> "" AND PDrive$ <> IDrive$ THEN _
EXIT SUB
CALL WildCard (PPrefix$,IPrefix$)
IF NOT ZOK THEN _
EXIT SUB
CALL WildCard (PExt$,IExt$)
DoesMatch = ZOK
END SUB
'
' Pe 02/03/90---- Removed SendName and Testuser subs
'
'
' ********* Maple UPDTU... ******
'
'
20705 ' $SUBTITLE: 'UpdtUpload -- Updates upload directory'
' $PAGE
' SUBROUTINE NAME -- UpdtUpload
'
' INPUT PARAMETERS -- PARAMETER MEANING
' ZFileName$
' ZUpldDir$
' ZFileNameHold$
' ZShareIt
' ZFMSDirectory$
' ZWasQ!
' TCA!
'
' OUTPut PARAMETERS -- ZBytesInFile#
' ZSecsPerSession!
'
' SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
' DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
'
SUB UpdtUpload (ZCategoryName$(1),ZCategoryCode$(1),LinesInDesc,WasFF) STATIC '<===
ON WasFF GOTO 20710,20724,20723 'Pe 11/20/89
20710 ZAbort = ZFalse ' PE ZAbort MOD
CALL QuickTPut1 ("Describe " + ZFileNameHold$ +ZCrLf$ + _
" (Begin with / if for Sysop only) or enter the word ABORT to cancel") ' Bh
CALL QuickTPut1 (LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
ZMaxDescLen - 4) + "..Max>")
CALL QuickTPut ("? ",0)
ZOutTxt$ = ""
ZSubParm = 1
ZParseOff = ZTrue
CALL TGet
CALL Carrier
IF ZSubParm = -1 THEN _ 'Pe 11/20/89
EXIT SUB 'Pe 11/20/89
TempUserIn$ = ZUserIn$ 'Pe 02/17/90
CALL AllCaps (TempUserIn$) 'Pe 02/17/90
IF TempUserIn$ = "ABORT" THEN _ 'Pe 02/17/90
ZAbort = ZTrue : _
TempUserIn$ = "" : _ 'Pe 02/17/90
EXIT SUB
TempUserIn$ = "" 'Pe 02/17/90
IF LEN(ZUserIn$) > ZMaxDescLen OR LEN(ZUserIn$) < 5 THEN _
CALL QuickTPut (" Description must be 5 chars min," + STR$(ZMaxDescLen) + " chars max",1) : _
CALL QuickTPut (" ENTER the word Abort to cancel transfer....",1) : _
GOTO 20710
20712 Desc$ = ZUserIn$
IF NOT ZLimitSearchToFMS THEN _
IF ZFMSDirectory$ <> ZUpldDir$ THEN _
IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
GOTO 20722_
ELSE GOTO 20717
20715 IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
UCat$ = "***" : _
GOTO 20722
UCat$ = ZDefaultCatCode$
20717 IF ZSubParm = -1 OR _
ZUserSecLevel < ZSLCategorizeUplds THEN _
GOTO 20722
20719 CALL BufFile (ZUpcatHelp$,WasX)
20720 ZOutTxt$ = "Upload best fits which category (H=help)" ' Bh
ZSubParm = 1
CALL TGet
IF ZSubParm = -1 THEN _
EXIT SUB 'Pe 11/20/89
IF ZWasQ = 0 THEN _
GOTO 20719
CALL AllCaps (ZUserIn$(1))
IF ZUserIn$(1) = "H" OR _
ZUserIn$(1) = "*" OR _
ZUserIn$(1) = "?" THEN _
GOTO 20719
CALL SearchArray (ZUserIn$(1),ZCategoryName$(),ZNumCategories,Found)
IF Found > 0 THEN _
UCat$ = ZCategoryCode$(Found) : _
IF LEN(UCat$) > 0 AND LEN(UCat$) < 4 AND INSTR(UCat$,",") = 0 THEN _
GOTO 20722
UCat$ = ""
IF NOT ZLimitSearchToFMS THEN _
StrewTo$ = ZDirPath$ + _
ZUserIn$(1) + _
"." + _
ZDirExtension$ : _
CALL FindIt (StrewTo$) : _ 'Pe 11/21/89
IF ZOK THEN _
GOTO 20722 _
ELSE CALL WORDInFile (ZUpcatHelp$,ZUserIn$(1),ZOK) : _
IF ZOK THEN _
GOTO 20722
StrewTo$ = ""
CALL QuickTPut1 ("No such category " + ZUserIn$(1))
GOTO 20719 'Pe 11/21/89
20722 IF ZUserSecLevel >= ZAskExtendedDesc AND _
ZMaxExtendedLines > 0 AND ZSubParm <> -1 THEN _
ZOutTxt$ = "Want to add EXTRA INFORMATION for " + _ ' Bh
ZFileNameHold$ + " (Y,[N])" : _
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL TGet : _
IF ZSubParm <> -1 THEN _
IF ZYes THEN _
CALL SkipLine (2):_
CALL QuickTPut (CHR$(7)+ " You can type in extra info AFTER the UPLOAD is Completed",2) : _ ' Bh
CALL DelayTime (2) :_
ZGetExtDesc = ZTrue
'
'******** Pe Upload changes *******
'
' need to add file for RBBS to read when DOORING to external protocols
' to remember Description, CatCode ect ect...should be done around this
' Point since we could use this info on batch Uploads also (future RBBS)
' following are variables we need to save and later restored
'
' ZFileName$
' ZFileNameHold$
' Desc$
' UCat$
' ZAbort
' ZGetExtDesc
'
IF ZPrivateDoor THEN
CALL OpenOutW ("UPDESC" +ZNodeID$ +".LST")
Print #2, ZFileName$
Print #2, ZFileNameHold$
Print #2, Desc$
Print #2, UCat$
Print #2, ZActiveFMSDir$
Print #2, ZFMSDirectory$
Print #2, ZAbort
Print #2, ZGetExtDesc
Print #2, StrewTo$
Print #2, ZAllwaysStrewTo$
Print #2, ZUpldDir$
Close 2
END IF
EXIT SUB
' ********* routine AFTER the Upload is successfull and Extended = True *****
20723 ZUserIn$ = Desc$
WasX$ = DATE$
WasZ$ = LEFT$(WasX$,6) + _
RIGHT$(WasX$,2)
ZWasEN$ = StrewTo$
GOSUB 20730
ZWasEN$ = ZAllwaysStrewTo$
GOSUB 20730
GOTO 20728 'CHANGE from 20725 to 20728 'Pe 09/12/89
'
'***** ENTRY POINT WHEN UPLOAD is Finished ***********
'
20724 IF ZPrivateDoor THEN
CALL OpenWork (2,"UPDESC" +ZNodeID$ +".LST")
While Not EOF(2)
Input #2, ZFileName$
Input #2, ZFileNameHold$
Input #2, Desc$
Input #2, UCat$
Input #2, ZActiveFMSDir$
Input #2, ZFMSDirectory$
Input #2, ZAbort
Input #2, ZGetExtDesc
Input #2, StrewTo$
Input #2, ZAllwaysStrewTo$
InPut #2, ZUpldDir$
Wend
Close 2
END IF
GOSUB 20734 'find uploaded file
'
CALL TimeRemain (MinsRemaining)
IF ZPrivateDoor THEN _
WasX! = ZUpldTimeFactor! * ZWasQ! _
ELSE WasX! = ZUpldTimeFactor! * (ZSecsUsedSession! - ZWasQ!)
'
'************************8 New Convert code begins here 8*******************
' Orig mods by Warren Muldrow
'
' additional mods by Pete Eibl moved code to callable Subroutines 09/25/89
' added X2ZIP?.LST.......01/18/90
'
' Zip Convert code. Does the following:
' IF X2ZIP? (?=Node #) is found then any file extension
' Listed in this file is NOT touched any other file will
' Be converted to ZIP format. IF the file is NOT found then
' user is asked to convert file....!!
' The First line determins weather to ask user to Convert or not
' This should either be a Yes or NO (in Upper case only) if Yes
' then user has the option of converting the file the rest of the
' file should have one EXTENSION per line including the "."
' ex: .ARC <CR>
'
' PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
' should be in the DOS path or the RBBS directory. WHAT is used by
' ZOO.BAT
'
' The Library work path (Config parm # 304) is used for a work area !!!
'
IF ZAbort = ZTrue THEN _ 'Corrects aborted uploads
EXIT SUB 'corrects aborted uploads
' CALL BreakFileName (ZFileName$, WDR$, WZZ$, WX$, ZTrue) 'Pe 11/26/89
'TooZip$ = "X2ZIP" + ZNodeID$ + ".LST"
'CALL FindIt (TooZip$)
'IF NOT ZOK THEN _ 'Pe 02/06/90
'AskToConvert = ZTrue : _
' GOTO 20725
'CALL OpenWork (2,TooZip$)
' WHILE NOT EOF(2)
' INPUT #2, Check$
' IF Check$ = "Yes" THEN _
' AskToConvert = ZTrue :_
' CLOSE 2 : _
' GOTO 20725
' IF WX$ = Check$ THEN _
' CLOSE 2: _
' GOTO 20727
' WEND
' CLOSE 2
''
'20725 IF ZAutoEnd = 1 THEN 'Pe 01/24/90
' IF WX$ = Check$ THEN GOTO 20727 Else GOTO 20726 'Pe 01/24/90
' END IF
'IF ZSysop OR ZUserSecLevel > = ZAddDirSecurity OR AskToConvert = ZTrue THEN
'AskToConvert = ZFalse
' ZSubParm = 1
' ZOutTxt$ = " Convert or verify " + ZFileName$ + " ([Y],N) "
' ZTurboKey = -ZTurboKeyUser
' CALL TGet
' IF ZSubParm = -1 THEN _
' EXIT SUB
' IF ZNO THEN _
' GOTO 20727
' END IF
'20726 IF ZLocalUser THEN _ 'Pe 01/23/90 added line number
' CALL LOCALCONVERT (WDR$,WZZ$,WX$,Desc$) _ 'Pe 10/05/89
' ELSE _
' CALL CONVERT2ZIP (WDR$,WZZ$,WX$,Desc$) 'Pe 10/05/89
''
'20727 GOSUB 20734 'Pe 11/21/89
'
'IF RIGHT$(ZFileNameHold$,3) = "ZIP" THEN
' CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ + " .......",2)
' CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT
' ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
' ADDCMT2$ = ZCrLf$ +"Description: " + Desc$
' ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$
' CALL OpenOutW (CommentName$)
' PRINT #2, ADDCOMMENT$
' CLOSE 2
' ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$
' SHELL "COMMAND.COM /C "+ADDCMT$
'END IF
'
ZOK = 0
CALL CheckNovell (ZOK)
IF ZOK <> -1 THEN _
CALL SetSharedAttr (ZFileName$, ZOK) : _
IF ZOK <> 0 THEN _
CALL PScrn ("Error setting shared attribute")
IF ZGetExtDesc THEN _
EXIT SUB
' ZOutTxt$ = "" 'Pe 03/04/90
WasX$ = DATE$
' WasZ$ = LEFT$(WasX$,6) + RIGHT$(WasX$,2)
WasZ$ = LEFT$(WasX$,2) + MID$(WasX$,4,2) + RIGHT$(WasX$,2)
' StrewTo$ = "" 'Pe 03/04/90
ZUserIn$ = Desc$
ZWasEN$ = ZAllwaysStrewTo$
GOSUB 20730
ZWasEN$ = StrewTo$
GOSUB 20730
'
20728 IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
WZZ$ = "************" : _
WX$ = ""
CALL AMorPM 'Pe 11/25/89
IF ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ THEN _ 'Pe 11/25/89
ULBYNAME$ = "ZSysop" _ 'Pe 11/25/89
ELSE ULBYNAME$ = ZActiveUserName$ 'Pe 11/25/89
ULXXX$ = WZZ$+WX$+SPACE$(13-(LEN(WZZ$)+LEN(WX$))) 'Pe 01/24/90
UPLOADLG$ = "{C1"+ ULXXX$ + _ 'Pe 01/24/90
"{C2"+ ULBYNAME$+SPACE$(34-LEN(ULBYNAME$)) + _ 'Pe 01/24/90
"{C3"+ DATE$ + " " + _ 'Pe 01/24/90
"{C4"+ ZTime$+" {C0" 'Pe 01/24/90
CALL OpenWorkA ("UPLOADLG.DEF") 'Pe 01/09/90
CALL PrintWorkA (UPLOADLG$) 'Pe 11/25/89
CLOSE 2 'Pe 01/18/90
IF ZFMSDirectory$ <> ZUpldDir$ THEN _
IF LEFT$(ZUserIn$,1) = "/" OR LEFT$(ZUserIn$,1) = "\" THEN _
CALL UpdtCalr (ZUserIn$,2): _
GOTO 20729
'******************
ZWasEN$ = ZUpldDir$
GOSUB 20730
20729 ZWasDF$ = " >> uploaded << "
ZUplds = ZUplds + 1
ZGlobalUplds = ZGlobalUplds + 1
ZULBytes! = ZULBytes! + ZBytesInFile#
ZGlobalULBytes! = ZGlobalULBytes! + ZBytesInFile#
CALL TimeRemain (MinsRemaining!)
ZTimeCredits! = ZTimeCredits! + WasX!
ZSecsPerSession! = ZSecsPerSession! + WasX!
IF ZPrivateDoor THEN _
WasX! = (WasX! - ZWasQ!) / 60.0 _
ELSE WasX! = (WasX! - ZSecsUsedSession! + ZWasQ!)/60.0
WasX$ = STR$(FIX(WasX!*10.0))
WasX$ = LEFT$(WasX$,LEN(WasX$)-1) + "." + RIGHT$(WasX$,1)
IF WasX! > 1.0 THEN _
CALL QuickTPut1 ("Session time increased by"+WasX$+" minutes")
CALL QuickTPut ("Upload successful. Thanks for the file, " + ZFirstName$ ,1) ' Bh
CALL DelayTime (2) 'Pe 02/23/90
ZGetExtDesc = ZFalse
IF ZAutoEnd = 1 THEN _
ZFileSysParm = 7 : _
ZDnldCompleted = ZTrue 'Pe 02/05/90
EXIT SUB
20730 ' ---[ lock file ]---
IF ZWasEN$ = "" THEN _
RETURN
FMSFormat = ZFalse
IF ZWasEN$ = ZFMSDirectory$ OR ZLimitSearchToFMS THEN _
FMSFormat = ZTrue _
ELSE CALL FindIt (ZWasEN$) : _
IF ZOK THEN _
CALL ReadDir (2,1) : _ 'Pe 11/22/89
IF ZErrCode = 0 THEN _
FMSFormat = (LEFT$(ZOutTxt$,4) = "\FMS")
IF NOT FMSFormat THEN _
ReadBackwards = ZFalse : _
FixedLen = 0 : _
ZUserIn$ = Desc$ _
ELSE FixedLen = 28 + ZMaxDescLen : _ ' Bh 082790
' ELSE FixedLen = 34 + ZMaxDescLen : _
ZUserIn$ = Desc$ + _
SPACE$(ZMaxDescLen - LEN(Desc$)) + _
UCat$ + _
SPACE$(3 - LEN(UCat$)) : _
ReadBackwards = ZTrue : _
CALL FindIt (ZWasEN$) : _
IF ZOK THEN _
CALL ReadDir (2,1) : _
IF ZErrCode = 0 THEN _
ReadBackwards = (INSTR(ZOutTxt$," TOP ") = 0)
CALL LockAppend
IF ZErrCode <> 0 THEN _
GOTO 20731
' ---[ append ]---
IF ZGetExtDesc THEN _
IF ReadBackwards THEN _
FOR WasI = LinesInDesc TO 1 STEP -1 : _
GOSUB 20732 : _
NEXT
' CALL AllCaps (ZUserIn$) ' Bh 090690
PRINT #2,USING "\ \####### & &"; _ ' Bh 083090
ZFileNameHold$; _
ZBytesInFile#; _
WasZ$; _
ZUserIn$
IF ZGetExtDesc THEN _
IF NOT ReadBackwards THEN _
FOR WasI = 1 TO LinesInDesc : _
GOSUB 20732 : _
NEXT
20731 CALL UnLockAppend
FixedLen = 0
RETURN
20732 WasX$ = ZOutTxt$(WasI)
CALL Trim (WasX$)
IF WasX$ = "" THEN _
RETURN
IF NOT FMSFormat THEN _
PRINT #2," ";ZOutTxt$(WasI) : _
RETURN
IF FixedLen > LEN(ZOutTxt$(WasI)) THEN _
WasX$ = SPACE$(FixedLen - 1 - LEN(ZOutTxt$(WasI))) + "." _
ELSE WasX$ = ""
PRINT #2, " ";LEFT$(ZOutTxt$(WasI),FixedLen);WasX$
RETURN
20734 CALL FindIt (ZFileName$)
20736 IF NOT ZOK THEN _
ZBytesInFile# = 0.0_
ELSE ZBytesInFile# = LOF(2)
IF ZBytesInFile# < 2.0 THEN _
EXIT SUB
RETURN
END SUB
20741 ' $SUBTITLE: 'BadFile - subroutine to find bad file names'
' $PAGE
'
' NAME -- BadFile
'
' INPUTS -- PARAMETER MEANING
' ZViolation$
' ZViolationsThisSession
' FilName$ NAME OF FILE
'
' OUTPUTS -- Result 1 = FILE NAME IS OK
' 2 = CHARACTER NOT ALLOWED
' 3 = SYSTEM CRASH ATTEMPT
' ZViolationsThisSession NUMBER OF VIOLATIONS
' FilName$ Gets capitalized
'
' PURPOSE -- To protect RBBS-PC against the use of bad file names
' to either crash the system or to breach RBBS-PC's security.
'
SUB BadFile (FilName$,Result) STATIC
'
'
' * TEST FOR INVALID CHARACTERS IN FILENAME
'
'
Result = 2
IF LEN(FilName$) < 1 THEN _
EXIT SUB
CALL BadFileChar (FilName$,ZOK)
IF NOT ZOK THEN _
EXIT SUB
CALL AllCaps (FilName$)
WasXX = INSTR(FilName$,".")
IF WasXX > 0 THEN _
IF WasXX < LEN(FilName$) THEN _
WasXX = INSTR(WasXX + 1,FilName$,".") : _
IF WasXX > 0 THEN _
EXIT SUB
WasXX = LEN(FilName$)
IF WasXX => 3 THEN _
IF INSTR("PRN:CON:AUX:NUL:",FilName$) THEN _
GOTO 20742
IF WasXX => 4 THEN _
IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FilName$) THEN _
GOTO 20742
CALL BreakFileName (FilName$,Pre$,Body$,Ext$,ZFalse)
IF LEN(Pre$) > 64 OR LEN(Body$) > 8 OR LEN(Body$) < 1 OR LEN(Ext$) > 3 THEN _
EXIT SUB
WasXX = LEN(Body$)
IF WasXX => 3 THEN _
IF INSTR("PRN:CON:AUX:NUL:",Body$) THEN _
GOTO 20742
IF WasXX => 4 THEN _
IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",Body$) THEN _
GOTO 20742
Result = 1
EXIT SUB
20742 ZViolationsThisSession = ZMaxViolations
ZViolation$ = ZViolation$ + _
FilName$
Result = 3
END SUB
'
'21105 ' $SUBTITLE: 'Library - sub to support Library downloads'
' $PAGE
'
' NAME -- Library
'
' INPUTS -- PARAMETER MEANING
' ZSubParm 1 = DISPLAY ACTIVE AREA
' 2 = CHANGE ACTIVE AREA
' 3 = DISPLAY PC-SIG
' DISCLAIMER
' 4 = ARCHIVE Library DISK
' 5 = DOWNLOAD COMPLETED
' ZLibType 0 = No Library ACTIVE
' 1 = Library FROM PC-SIG
' ZLibDrive$ Library DRIVE ID
'
' OUTPUTS -- NONE
'
' PURPOSE -- To provide access support for library drives
'
' SUB Library STATIC
' STATIC LibSubdirName$(1)
' STATIC DiskTitle$
' ZErrCode = 0
' IF ZLibType = 0 THEN _
' EXIT SUB
' IF ZLibDiskChar$ = "" THEN _
' ZLibDiskChar$ = "0000"
' ON ZSubParm GOTO 21110, 21115, 21130, 21140, 21159
'21110 IF ZLibDiskChar$ = "0000" THEN _
' ZOutTxt$ = "No Library Book currently selected" _ ' Bh
' ELSE ZOutTxt$ = "Library Book " + _ ' Bh
' ZLibDiskChar$ + _
' " selected - " + _
' DiskTitle$
' CALL QuickTPut1 (ZOutTxt$)
' IF LibDiskArc$ = "" THEN _
' EXIT SUB
' IF INSTR(ZLibDiskArc$,"ARC") THEN _
' Extension$ = "ARC" _
' ELSE IF INSTR(ZLibDiskArc$,"ZIP") THEN _
' Extension$ = "ZIP" _
' ELSE IF INSTR(ZLibDiskArc$,"LHA") THEN _
' Extension$ = "LHZ" _
' ELSE Extension$ = ZDefaultExtension$
' FOR LibDisplayCount = 0 TO LibLoopCount - 1
' IF LibSubdirName$(LibDisplayCount) <> "" THEN _
' CALL QuickTPut1 (LibSubdirName$(LibDisplayCount) + _
' "." + Extension$ + " ready for transmission!")
' NEXT
' EXIT SUB
'21115 IF ZWasQ = 1 THEN _
' ZOutTxt$ = "Change Library Book from " + _ ' Bh
' ZLibDiskChar$ + _
' " to (1 -" + _
' STR$(ZLibMaxDisk) + _
' ")" : _
' ZSubParm = 1 : _
' CALL TGet : _
' IF ZSubParm = -1 THEN _
' EXIT SUB _
' ELSE IF ZWasQ = 0 THEN _
' ZLibDiskChar$ = "0000" : _
' ChdirLib$ = ZLibDrive$ + _
' "\" : _
' GOTO 21126
'21117 IF VAL(ZUserIn$(ZWasQ)) < 1 OR VAL(ZUserIn$(ZWasQ)) > ZLibMaxDisk THEN _
' ZWasQ = 1 : _
' GOTO 21115
'21120 ZLibDiskChar$ = ZUserIn$(ZWasQ)
' CLOSE 2
' ZLibDiskChar$ = RIGHT$("0000" + ZLibDiskChar$,4)
'21121 CALL FindIt("RBBS-CDR.DEF")
' IF NOT ZOK THEN _
' EXIT SUB
'21122 IF EOF(2) THEN _
' ZLibDiskChar$ = "" : _
' EXIT SUB
' INPUT #2,WorkSubdir$,ChdirLib$
' LINE INPUT #2,DiskTitle$
' IF ZLibDiskChar$ = WorkSubdir$ THEN _
' ChdirLib$ = ZLibDrive$ + _
' ChdirLib$ : _
' GOTO 21126
' GOTO 21122
'21126 ZErrCode = 0
' CALL ChangeDir (ChdirLib$)
' IF ZErrCode <> 0 THEN _
' ZLibDiskChar$ = "0000" : _
' ChdirLib$ = ZLibDrive$ + _
' "\" : _
' GOTO 21126
' EXIT SUB
'21130 IF ZLibType <> 1 THEN _
' EXIT SUB
' CALL SkipLine(1)
' ZOutTxt$ = "HIS BOARD's Christian Library is being accessed. The file you " ' KG011001 ' Bh
' CALL QuickTPut1 (ZOutTxt$)
' ZOutTxt$ = "are about to download can also be ordered as BOOK " + _ ' KG011001 ' Bh
' ZLibDiskChar$
' CALL QuickTPut1 (ZOutTxt$)
' ZOutTxt$ = "from HIS BOARD, P.O. Box 22, Ventura, CA 93002" ' Bh
' CALL QuickTPut (ZOutTxt$,2)
' EXIT SUB
'21140 IF ZLibDiskChar$ = "0000" THEN _
' CALL QuickTPut1 ("You must first Select a Library Book with the C command!") : _ ' KG011903 ' Bh
' EXIT SUB
' ZOutTxt$ = "Compress the contents of Library Book - " + _ ' KG011903 ' Bh
' ZLibDiskChar$ + _
' " for faster downloading (Y/[N])" ' KG011903 ' Bh
' ZSubParm = 1
' CALL TGet
' IF NOT ZLocalUser THEN _
' IF ZSubParm = -1 THEN _
' EXIT SUB
' IF NOT ZYes THEN _
' EXIT SUB
'21145 CALL KillWork (ZLibWorkDiskPath$ + _
' ZLibNodeID$ + _
' "BOOK*." + Extension$) ' AC100101 ' Bh
'21150 CALL QuickTPut1 ("Work/RAM disk purged")
' CALL QuickTPut1 ("I'm now doing compression with " + _ ' KG011903 ' Bh
' ZLibArcProgram$ + _
' " May take a few moments. Patience!") ' Bh
' REDIM LibSubdirName$(10)
' LibSubdirChar$ = ""
' LibLoopCount = 0
' GOSUB 21157
' ZOutTxt$ = "Contents of Library Book - " + _ ' Bh
' ZLibDiskChar$ + _
' " now compressed and ready for you to D)ownload" ' KG011903 ' Bh
' CALL QuickTPut1 (ZOutTxt$)
' ZOutTxt$ = "Searching for Sub-directories"
' CALL QuickTPut1 (ZOutTxt$)
' GOSUB 21158
' LibDiskArc$ = ZLibDiskChar$
''
'' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
''
' Treedir$ = ZLibWorkDiskPath$ + _
' ZLibNodeID$ + _
' "DKDIR.LST"
' DirCmd$ = "DIR " + _
' ZLibDrive$ + _
' " | FIND " + _
' CHR$(34) + _
' " <DIR> " + _
' CHR$(34) + _
' " > " + _
' Treedir$
'21151 SHELL DirCmd$
' CALL SkipLine (2)
' LOCATE 24,1
' ZErrCode = 0
'21152 CLOSE 2
'21153 CALL OpenWork (2,Treedir$)
' LibSubdirCount = 0
' WHILE NOT EOF(2)
' LINE INPUT #2, Dirrec$
' IF LEFT$(Dirrec$,1) <> "." THEN _
' LibSubdirCount = LibSubdirCount + 1 : _
' LibSubdirName$(LibSubdirCount) = _
' LEFT$(Dirrec$,8)
' WEND
' CLOSE 2
' LibLoopCount = 1
' IF LibSubdirCount = 0 THEN _
' GOTO 21156
' ZOutTxt$ = STR$(LibSubdirCount) + _
' " Subdirectories belonging to Library Book - " + _ ' Bh
' ZLibDiskChar$
' CALL QuickTPut1 (ZOutTxt$)
' FOR LibLoopCount = 1 TO LibSubdirCount
' IF NOT ZLocalUser THEN _
' CALL Carrier : _
' IF ZSubParm THEN _
' GOTO 21155
' LibSubdirChar$ = MID$("ABCDEFGHI",LibLoopCount,1)
' ZOutTxt$ = "Creating " + _
' ZLibNodeID$ + _
' "BOOK" + _
' ZLibDiskChar$ + _
' LibSubdirChar$ + "." + ZDefaultExtension$ + _
' " using " + ZLibArcProgram$
' CALL QuickTPut1 (ZOutTxt$)
' CHDIR ChdirLib$ + _
' "\" + _
' LibSubdirName$(LibLoopCount)
' GOSUB 21157
' ZOutTxt$ = "Book - " + _
' ZLibDiskChar$ + _
' "; Subdirectory" + _
' " -" + _
' STR$(LibLoopCount) + _
' " has been compressed and is ready for you to D)ownload" ' Bh ' KG011903
' CALL QuickTPut1 (ZOutTxt$)
' GOSUB 21158
'21155 NEXT LibLoopCount
'21156 CALL Carrier
' ZOutTxt$ = ""
' EXIT SUB
'21157 LibArc$ = ZLibArcPath$ + _
' ZLibArcProgram$ + _
' " " + _
' ZLibWorkDiskPath$ + _
' ZLibNodeID$ + _
' "BOOK" + _ ' Bh
' ZLibDiskChar$ + _
' LibSubdirChar$ + _
' " " + _
' ZLibDrive$ + _
' "*.* > gate1 "
' IF ZUseDeviceDriver$ <> "" AND ZFossil AND NOT ZLocalUser THEN _
' LibArc$ = ZDiskForDos$ + _
' "COMMAND /C " + _
' LibArc$ + _
' " > gate1 " + _
' ZUseDeviceDriver$
' SHELL LibArc$
' CALL SkipLine (2)
' LOCATE 24,1
' RETURN
'21158 LibSubdirName$(LibLoopCount) = ZLibNodeID$ + _
' "BOOK" + _ ' Bh
' ZLibDiskChar$ + _
' LibSubdirChar$
' RETURN
'21159 FOR LibDisplayCount = 0 TO LibLoopCount - 1
' IF LibSubdirName$(LibDisplayCount) = ZOutTxt$ THEN _
' LibSubdirName$(LibDisplayCount) = ""
' NEXT
' END SUB
'
21598 ' $SUBTITLE: 'XferType - sub to identify file xfer protocol'
' $PAGE
'
' NAME -- XferType
'
' INPUTS -- PARAMETER MEANING
' Index = 1 Manual select for up/download
' = 2 Default select
' = 3 Set transfer default
' ZOutTxt$
' ZUserIn$(1)
' ZWasQ
' ZReliableMode
' ZTransferOption$
' ZUserXferDefault$
' ZXferSupport
'
' OUTPUTS -- ZCheckSum
' ZFLen
' ZWasFT$
'
' PURPOSE -- To identify the file transfer protocol (either
' from the user's default or via explicit selection)
'
SUB XferType (Index,SkipHelp) STATIC
IF ZTransferOption$ = "" OR ZUserSecLevel <> PrevUSL THEN _
CALL Protocol : _
PrevUSL = ZUserSecLevel
WasX$ = ZOutTxt$ + "Protocol"
ON Index GOTO 21600,21620,21600
'
'
' * MANUAL SELECT OF Transfer Protocol
'
'
21600 IF SkipHelp THEN _
GOTO 21604
21602 CALL BufFile (ZHelpPath$ + "UF" + ZHelpExtension$,WasX)
IF ZSubParm = -1 THEN _
EXIT SUB
21604 ZStopInterrupts = ZTrue
IF Index = 3 THEN _
IF ZAnsIndex < ZLastIndex THEN _
GOTO 21605
CALL QuickTPut1 (WasX$)
CALL BufString (ZTransferOption$,4096,WasX)
CALL QuickTPut (MID$("?!",1-ZTurboKeyUser,1)+" ",0)
21605 ZOutTxt$ = ""
ZTurboKey = -ZTurboKeyUser
ZMacroMin = 2
ZSubParm = 1
ZSuspendAutoLogoff = ZTrue
ZStackC = ZTrue
IF Index = 3 THEN _
CALL PopCmdStack : _
WasX = ZAnsIndex _
ELSE ZSubParm = 1 : _
CALL TGet : _
WasX = 1
ZSuspendAutoLogoff = ZFalse
IF ZSubParm = -1 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
GOTO 21604
21606 ZWasZ$ = ZUserIn$(WasX)
'
'
' * DEFAULT SELECT OF Transfer Protocol
'
'
21610 CALL AllCaps (ZWasZ$)
IF INSTR("H",ZWasZ$) > 0 THEN _
GOTO 21602
ZFF = INSTR(ZDefaultXfer$,ZWasZ$)
IF ZFF < 1 THEN _
GOTO 21600
21612 ZWasFT$ = MID$(ZDefaultXfer$,ZFF,1)
ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
GOTO 21621
21620 ZFF = -1
IF ZCmdTransfer$ <> "" THEN _
ZWasZ$ = ZCmdTransfer$ : _
GOTO 21610
WasX = INSTR(ZDefaultXfer$,ZUserXferDefault$)
IF WasX > 0 THEN _
IF MID$(ZInternalEquiv$,WasX,1) <> "N" THEN _
ZWasZ$ = ZUserXferDefault$ : _
GOTO 21610
ZProtoPrompt$ = "None"
ZFF = 0
EXIT SUB
21621 IF ZFF = PrevFF AND PrevProtoDef$ = ZProtoDef$ THEN _
ZProtoPrompt$ = PrevProtoPrompt$ : _
EXIT SUB
PrevFF = ZFF
PrevProtoDef$ = ZProtoDef$
ZInternalProt$ = MID$(ZInternalEquiv$,ZFF,1)
ZCheckSum = (ZInternalProt$ = "X")
CALL FindIt (ZProtoDef$)
IF ZOK THEN _
GOTO 21623
WasX = INSTR("AXCYN",ZInternalProt$)
IF WasX < 1 THEN _
ZInternalProt$ = "N"
ZProtoPrompt$ = MID$("Ascii Xmodem Xmodem/CRCYmodem None",10*INSTR("AXCYN",ZInternalProt$)-9,10)
CALL TrimTrail (ZProtoPrompt$," ")
ZCheckSum = (ZInternalProt$ = "X")
ZFLen = 128 - 896 * (ZInternalProt$ = "Y")
ZBlockSize = ZFLen
IF ZInternalProt$ = "Y" THEN _
ZSpeedFactor! = 0.87 _
ELSE IF ZInternalProt$ = "A" THEN _
ZSpeedFactor! = 0.92 _
ELSE ZSpeedFactor! = 0.78
GOTO 21625
21623 CALL ReadParms (ZWorkAra$(),13,ZFF)
IF ZErrCode > 0 THEN _
ZFF = LEN(ZDefaultXfer$) : _
ZProtoPrompt$ = "None" : _
GOTO 21625
ZProtoPrompt$ = ZWorkAra$(1)
IF LEN(ZProtoPrompt$) > 2 THEN _
IF MID$(ZProtoPrompt$,2,1) = ")" THEN _
ZProtoPrompt$ = LEFT$(ZProtoPrompt$,1) + MID$(ZProtoPrompt$,3)
WasX = INSTR(ZProtoPrompt$+ZCrLf$,ZCrLf$)
ZProtoPrompt$ = LEFT$(ZProtoPrompt$,WasX-1)
CALL Trim (ZProtoPrompt$)
ZProtoMethod$ = LEFT$(ZWorkAra$(3),1)
CALL AllCaps (ZProtoMethod$)
ZReq8Bit = (LEFT$(ZWorkAra$(4),1) = "8")
ZDownTemplate$ = ZWorkAra$(12)
ZUpTemplate$ = ZWorkAra$(13)
WasX$ = ZWorkAra$(11)
WasX = INSTR(WasX$,"=")
ZAdvanceProtoWrite = ZFalse
IF WasX < 2 OR WasX >= LEN(WasX$) THEN _
ZFailureParm = 4 : _
ZFailureString$ = "F" _
ELSE ZFailureParm = VAL(LEFT$(WasX$,WasX-1)) : _
ZFailureString$ = MID$(WasX$,WasX+1) : _
WasX = INSTR(ZFailureString$,"=") : _
IF WasX > 0 THEN _
ZAdvanceProtoWrite = (MID$(ZFailureString$,WasX) = "=A") : _
ZFailureString$ = LEFT$(ZFailureString$,WasX-1)
ZProtoMacro$ = ZWorkAra$(10)
ZFakeXRpt = (LEFT$(ZWorkAra$(8),1) = "F")
ZBatchProto = (LEFT$(ZWorkAra$(6),1) = "B")
ZSpeedFactor! = VAL(ZWorkAra$(9))
IF ZSpeedFactor! < 0.1 THEN _
ZSpeedFactor! = 0.87
ZBlockSize = VAL(ZWorkAra$(7))
ZFLen = ZBlockSize
IF ZFLen < 1 THEN _
ZFLen = 128
21625 PrevProtoPrompt$ = ZProtoPrompt$
END SUB
' Pe 02/04/90
30000 ' $SUBTITLE: 'InitIBM - sub to create/open NetBIOS semaphore file'
' $PAGE
'
' NAME -- InitIBM (Written by Doug Azzarito)
'
' INPUTS -- NONE
'
' OUTPUTS -- ZSubParm = -1 Abort RBBS
'
' PURPOSE -- Open semaphore file "IBMFLAGS" on default drive as file #6
' Create file if it does not exits.
'
SUB InitIBM STATIC
'
'
' * SEE IF FILE EXISTS
'
'
ZShareIt = ZTrue
CALL BreakFileName (ZMainMsgFile$,IBMFlagFile$,Dummy$,Dummy$,ZTrue)
IBMFlagFile$ = IBMFlagFile$ + _
"IBMFLAGS"
CALL FindIt (IBMFlagFile$)
CLOSE 2
IF ZOK THEN _
GOTO 30020
'
'
' * CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE
'
'
OPEN IBMFlagFile$ ACCESS WRITE AS #6 LEN=2
FIELD 6, 2 AS LockBuf$
LSET LockBuf$ = MKI$(0)
FOR WasI = 1 TO 3
PUT 6
NEXT
CLOSE #6
30020 OPEN IBMFlagFile$ ACCESS READ WRITE SHARED AS #6 LEN=2
END SUB
30500 ' $SUBTITLE: 'OpenMsg - open the MESSAGES file'
' $PAGE
'
' NAME -- OpenMsg
'
' INPUTS -- PARAMETER MEANING
' ZActiveMessageFile$
' ZShareIt
'
' OUTPUTS -- ZMsgRec$
'
SUB OpenMsg STATIC
'
'
' * OPEN AND DEFINE MESSAGE FILE
'
'
CLOSE 1
IF ZShareIt THEN _
OPEN ZActiveMessageFile$ ACCESS READ WRITE SHARED AS #1 _
ELSE OPEN "R",1,ZActiveMessageFile$
FIELD 1,128 AS ZMsgRec$
END SUB
30595 ' $SUBTITLE: 'FindFKey - sub to handle local keyboard functions'
' $PAGE
'
' NAME -- FindFKey
'
' INPUTS -- PARAMETER MEANING
' ZActiveMenu$ INDICATOR OF ACTIVE MENU
' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE
' ZAutoDownDesired USER'S PREFERENCE FOR AUTODOWNLOADING
' ZCallersFile$ NAME OF CALLERS FILE
' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT
' ZCheckBulletLogon USER'S PREFERENCE FOR BULLETIN CHECK
' ZConfMode INDICATOR THAT USER IS IN A CONFERENCE
' ZCursorLine LINE THAT THE CURSOR IS AT
' ZCursorRow ROW THAT THE CURSOR IS AT
' ZDiskForDos$ DISK TO LOAD COMMAND.COM FROM
' ZDiskFullGoOffline INDICATOR OF WHAT TO DO WHEN DISK FULL
' ZExitToDoors FLAG INDICATING EXITING TO DOORS
' ZExpertUser FLAG FOR EXPERT/NOVICE USER MODE
' ZFirstName$ LOGGED ON USER'S First NAME
' ZF1Key FUNCTION KEY ONE VALUE
' ZF10Key FUNCTION KEY TEN VALUE
' ZWasGR GRAPHICS PREFERENCE OF USER
' ZLineFeeds SWTICH FOR USER'S LINE FEED PREFERENCE
' ZLocalUser FLAG INDICATING USER IS LOCAL
' ZMinLogonSec MINIMUM SECURITY TO LOGON
' ZModemGoOffHookCmd$ COMMAND TO TAKE MODEM OFF-HOOK
' ZModemInitBaud$ BAUD TO INITIALIZE MODEM AT
' ZNodeID$ NODE IDENTIFIER
' ZNodeRecIndex NODE RECORD Index FOR THIS NODE
' ZNulls Switch FOR USER'S PREFERENCE FOR Nulls
' ZPrinter Toggle INDICATING Printer IS AVAILABLE
' ZPromptBell USER'S PREFERENCE FOR BELLS ON PROMPTS
' SECONDS.PER.SESSION TIME LEFT IN CURRENT USER SESSION
' ZSkipFilesLogon USER'S LOGON NOTIFICIATION PREFERENCE
' ZSnoop Toggle INDICATING Snoop STATUS
' ZSubParm -8 = Sysop'S OPTION 6 REMOTELY
' -9 = GOT TO DOS
' -10 = Sysop GET'S SYSTEM NEXT
' ZSysop INDICATOR THAT USER IS Sysop
' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE
' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT
' ZUpperCase USER'S PREFERENCE FOR UPPER/LOWER CASE
' ZUserFileIndex Index INTO THE USER FILE FOR CALLER
' ZUserSecLevel USER'S SECURITY LEVEL
' USERT.TRANSFER.DEFAULT USER'S FILE Transfer DEFAULT PREFERENCE
'
' OUTPUTS --
' ZAdjustedSecurity Switch INDICATING TEMP. SECURITY CHANGE
' ZChatAvail Toggle INDICATING IF Sysop WILL CHAT
' ZFunctionKey VALUE 1 TO 10 CORRESPONDING TO
' THE FUNCTION KEY THAT WAS PRESSED
' ZKeyPressed$ CHARACTER STRING GENERATED BY KEY
' ZPrinter TOGGLE INDICATING Printer IS AVAILABLE
' ZSnoop Toggle INDICATING Snoop STATUS
' ZSysop INDICATOR THAT USER IS Sysop
' ZSysopAnnoy Toggle INDICATING Sysop IS AVAILABLE
' ZSysopNext Toggle SO Sysop GETS SYSTEM NEXT
' ZSubParm -1 Carrier LOST
' -2 CHAT MODE ACTIVATED
' -3 FORCE CALLER ON-LINE
' -4 EXIT TO SYSTEM IMMEDIATELY
' -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
' -6 TELL USER ACCESS IS DENIED
' -7 UPDATE CALLERS FILE AND DENY ACCESS
' ZUserSecLevel USER'S SECURITY LEVEL
'
' PURPOSE -- To determine if a function has been pressed on
' the PC'S keyboard that is running RBBS-PC.
'
SUB FindFKey STATIC
LookUp = ZSubParm
IF ZSubParm < -1 THEN _
ZSubParm = 0 : _
IF LookUp = - 8 THEN _
GOTO 33070 _
ELSE IF LookUp = - 9 THEN _
GOTO 31000 _
ELSE IF LookUp = - 10 THEN _
GOTO 33090
'
'
' * TEST FOR FUNCTION KEY PRESSED
'
'
30600 IF ZKeyboardStack$ = "" THEN _
ZKeyPressed$ = INKEY$ _
ELSE ZKeyPressed$ = ZKeyboardStack$ : _
ZKeyboardStack$ = ""
ZFunctionKey = 0
IF LEN(ZKeyPressed$) <> 2 THEN _
GOTO 33970
ZKeyPressed = ASC(RIGHT$(ZKeyPressed$,1))
' IF ZLocalUser AND NOT ZSysop THEN _
' ZKeyPressed$ = "" : _
' GOTO 33970
IF ZKeyPressed => ZF1Key AND _
ZKeyPressed <= ZF10Key THEN _
ZFunctionKey = ZKeyPressed - 58 : _
GOTO 30610
IF ZKeyPressed = 117 THEN _ 'Ctrl-End
ZFunctionKey = 11
IF ZKeyPressed = 73 THEN _ 'PgUp
ZFunctionKey = 12
IF ZKeyPressed = 72 THEN _ 'up arrow
ZFunctionKey = 13
IF ZKeyPressed = 80 THEN _ 'Down arrow
ZFunctionKey = 14
IF ZKeyPressed = 81 THEN _ 'PgDn
ZFunctionKey = 15
IF ZKeyPressed = 75 THEN _ 'left arrow
ZFunctionKey = 16
IF ZKeyPressed = 77 THEN _ 'Right arrow
ZFunctionKey = 17
IF ZKeyPressed = 141 THEN _ 'CTRL-up arrow
ZFunctionKey = 18
IF ZKeyPressed = 132 THEN _ 'CTRL-PgUp (same as CTRL-UP)
ZFunctionKey = 18
IF ZKeyPressed = 145 THEN _ 'CTRL-down arrow
ZFunctionKey = 19
IF ZKeyPressed = 118 THEN _ 'CTRL-PgDn (same as CTRL-DOWN)
ZFunctionKey = 19
IF ZKeyPressed = 115 THEN _ 'CTRL-left arrow
ZFunctionKey = 20
IF ZKeyPressed = 116 THEN _ 'CTRL-right arrow
ZFunctionKey = 21
IF ZKeyPressed = 79 THEN _ 'End (a nice way to kick user off)
ZFunctionKey = 22
30610 ZKeyPressed$ = ""
IF ZFunctionKey < 1 OR ZFunctionKey > 22 THEN _
GOTO 33970
IF ZFunctionKey < 10 AND (ZFunctionKey <> 8) THEN _
GOTO 30620
IF ZToggleOnly THEN _
ZSubParm = 1 : _
GOTO 33970
30620 ON ZFunctionKey GOTO 31000, _ ' 1 = F1
32000, _ ' 2 = F2
33000, _ ' 3 = F3
33040, _ ' 4 = F4
33060, _ ' 5 = F5
33070, _ ' 6 = F6
33090, _ ' 7 = F7
33110, _ ' 8 = F8
33130, _ ' 9 = F9
33150, _ ' 10 = F10
31398, _ ' 11 = CTRL END
33200, _ ' 12 = PGUP
33170, _ ' 13 = UP ARROW
33180, _ ' 14 = DOWN ARROW
33220, _ ' 15 = PGDN
33240, _ ' 16 = LEFT ARROW
33250, _ ' 17 = RIGHT ARROW
33170, _ ' 18 = CTRL-UP ARROW
33180, _ ' 19 = CTRL-DOWN
33245, _ ' 20 = CTRL-LEFT
33255, _ ' 21 = CTRL-RIGHT
31398 ' 22 = END
'
'
' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)
'
'
31000 ZSubParm = -10
CALL Carrier
IF ZSubParm = 0 THEN _
GOTO 33970
ZFileName$ = ZNodeWorkDrvPath$ + "RBBS" + ZNodeFileID$ + "F1.DEF"
CLOSE 2
CALL OpenOutW (ZFileName$)
PRINT #2,MID$(ZFileName$,3,7)
IF ZExitToDoors THEN _
ZSubParm = -4 : _
GOTO 33970
CALL OpenCom(ZModemInitBaud$,",N,8,1")
CALL TakeOffHook
ZSubParm = -5
GOTO 33970
'
'
' * END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT
'
'
31398 IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
IF INSTR("MUF",ZActiveMenu$) > 0 THEN _
GOTO 31399
ZCursorLine = CSRLIN
ZCursorRow = POS(0)
LOCATE 25,1
WasD$ = SPACE$(79)
GOSUB 33210
LOCATE 25,1
WasD$ ="Cannot FORCE OFF until user reaches MAIN menu"
GOSUB 33210
CALL DelayTime (1)
LOCATE ZCursorLine,ZCursorRow
ZSubParm = 1
CALL Line25
GOTO 33970
31399 IF ZFunctionKey = 22 THEN _
CALL SkipLine (2) : _
CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", SYSOP needs the system.") : _
CALL DelayTime (8 + ZBPS) : _
ZSubParm = -6 : _
GOTO 33970
CALL QuickTPut1 (ZFirstName$ + ", goodbye and don't call back")
CALL DelayTime (8 + ZBPS) : _
IF ZUserFileIndex < 1 THEN _
ZSubParm = -6 : _
GOTO 33970
ZUserSecLevel = ZMinLogonSec - 1
CALL DenyAccess
ZSubParm = -7
GOTO 33970
'
'
' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)
'
'
32000 IF NOT ZLocalUser THEN _
CALL SkipLine (1) : _
CALL QuickTPut1 ("Sysop exiting to DOS. Please wait...") : _
ZFunctionKey = 0 : _
CALL DelayTime (3)
CALL ShellExit (ZDiskForDos$ + "COMMAND")
CLS
IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
ZSubParm = 2
CALL Line25
CALL QuickTPut1 ("Sysop back from DOS. Returning control to you.")
ZCommPortStack$ = ZCarriageReturn$
GOTO 33970
'
'
' * F3 - COMMAND FROM LOCAL KEYBOARD (Printer Toggle)
'
'
33000 ZPrinter = NOT ZPrinter
ChangeValue = ZPrinter
FieldPosition = 38
GOTO 33950
'
'
' * F4 - COMMAND FROM LOCAL KEYBOARD (Sysop ANNOY)
'
'
33040 ZSysopAnnoy = NOT ZSysopAnnoy
ChangeValue = ZSysopAnnoy
FieldPosition = 34
GOTO 33950
'
'
' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)
'
'
33060 ZFunctionKey = 0
ZSubParm = -3
GOTO 33970
'
'
' * F6 - COMMAND FROM LOCAL KEYBOARD (Sysop AVAILABLE Toggle)
' * 6 - COMMAND FROM Sysop MENU (Sysop AVAILABLE Toggle)
'
'
33070 ZSysopAvail = NOT ZSysopAvail
ChangeValue = ZSysopAvail
FieldPosition = 32
GOTO 33950
'
'
' * F7 - COMMAND FROM LOCAL KEYBOARD (Sysop GETS SYSTEM NEXT)
'
'
33090 IF ERR=61 AND NOT ZDiskFullGoOffline THEN _
GOTO 33970
ZSysopNext = NOT ZSysopNext
ChangeValue = ZSysopNext
FieldPosition = 36
GOTO 33950
'
'
' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY Sysop SECURITY)
'
'
33110 ZSysop = NOT ZSysop
ZCursorLine = CSRLIN
ZCursorRow = POS(0)
LOCATE 25,1
WasD$ = SPACE$(79)
NumReturns = 0
CALL LPrnt (WasD$,NumReturns)
LOCATE 25,1
ZUserSecLevel = (1 + ZSysop) * _
ZUserSecSave - _
ZSysop * _
ZSysopSecLevel
WasD$ = "Sysop Privileges " + FNOffOn$(ZSysop)
CALL LPrnt (WasD$,NumReturns)
CALL DelayTime (3)
LOCATE ZCursorLine,ZCursorRow
ZSubParm = 1
CALL Line25
CALL SetPrompt
GOTO 33970
'
'
' * F9 - COMMAND FROM LOCAL KEYBOARD (Snoop Toggle)
'
'
33130 IF NOT ZSnoop THEN _
ZSnoop = ZTrue : _
LOCATE 24,1,0 : _
WasD$ = "SNOOP ON" : _
NumReturns = 0 : _
CALL LPrnt (WasD$,NumReturns) : _
ZSubParm = 2 : _
CALL Line25 _
ELSE LOCATE ,,0 : _
ZSnoop = ZFalse : _
CLS
33140 ChangeValue = ZSnoop
FieldPosition = 58
GOTO 33950
'
'
' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)
'
'
33150 GOTO 33160
33155 ZSubParm = 1
CALL Line25
GOTO 33970
33160 CALL UpdtCalr ("Sysop began chat",1)
ZPageStatus$ = ""
CALL SkipLine (1)
CALL QuickTPut1 ("Hello there " + _ ' Bh
ZFirstName$ + _
", this is " + _
ZSysopFirstName$ + _
" " + _
ZSysopLastName$ + _
" Mind if I interrupt a sec?") ' Bh
CALL TimeBack (1)
CALL SysopChat
CALL TimeBack (2)
ZCommPortStack$ = CHR$(13)
GOTO 33155
'
'
' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
'
'
33170 ZUserSecLevel = ZUserSecLevel + _
1 - 4 * (ZFunctionKey = 18)
GOTO 33190
'
'
' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE
'
'
33180 ZUserSecLevel = ZUserSecLevel - _
1 + 4 * (ZFunctionKey = 19)
33190 ZAdjustedSecurity = ZTrue
ZUserSecSave = ZUserSecLevel
IF (NOT ZConfMode) AND (NOT SubBoard) THEN _
ZOrigSec = ZUserSecLevel : _
ZSubParm = 2
CALL Line25
CALL SetPrompt
GOTO 33970
'
'
' * PGUP DISPLAY USER PROFILE
'
'
33200 IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
IF ZVoiceType <> 0 THEN _
ZTalkAll = ZTrue
CALL PageUp
WasD$ = MID$("NoviceExPERT",1 -6 * ZExpertUser,6)
GOSUB 33210
WasD$ = "GRAPHICS: " + _
MID$("None AsciiColor",ZWasGR * 5 + 1,5)
GOSUB 33210
WasD$ = "Protocol : " + _
ZUserXferDefault$
GOSUB 33210
WasD$ = "UPPER CASE " + _
MID$("and lowerONLY", 1 - 9 * ZUpperCase,9)
GOSUB 33210
WasD$ = "Line Feeds " + FNOffOn$(ZLineFeeds)
GOSUB 33210
WasD$ = "Nulls " + FNOffOn$(ZNulls)
GOSUB 33210
WasD$ = "Prompt Bell " + FNOffOn$(ZPromptBell)
GOSUB 33210
WasD$ = MID$("SKIP CHECK",1 -5 * ZCheckBulletLogon,5) + _
" old BULLETINS on logon."
GOSUB 33210
WasD$ = MID$("CHECKSKIP ",1 -5 * ZSkipFilesLogon,5) + _
" new files on logon."
GOSUB 33210
WasD$ = "Autodownload " + FNOffOn$(ZAutoDownDesired)
GOSUB 33210
ZTalkAll = ZFalse
GOTO 33970
33210 NumReturns = 1
CALL LPrnt(WasD$,NumReturns)
RETURN
'
'
' * PGDN CLEAR DISPLAY OF USER'S PROFILE
'
'
33220 IF NOT ZLocalUser THEN _
CALL Carrier : _
IF ZSubParm = -1 THEN _
GOTO 33970
CLS
GOTO 33155
'
'
' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE
'
'
33240 IF ZSecsPerSession! > 120 THEN _
ZSecsPerSession! = ZSecsPerSession! - 60
GOTO 33970
'
'
' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
'
'
33245 IF ZSecsPerSession! > 360 THEN _
ZSecsPerSession! = ZSecsPerSession! - 300
GOTO 33970
'
'
' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE
'
'
33250 IF ZSecsPerSession! < 86280 THEN _
ZSecsPerSession! = ZSecsPerSession! + 60
ZTimeLockSet = 0
GOTO 33970
'
'
' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES
'
'
33255 IF ZSecsPerSession! < 86040 THEN _
ZSecsPerSession! = ZSecsPerSession! + 300
ZTimeLockSet = 0
GOTO 33970
'
'
' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY
'
'
33950 IF ZSnoop THEN _
ZSubParm = 1 : _
CALL Line25
33960 IF ZConfMode = ZTrue THEN _
IF ZLocalUser THEN _
GOTO 33970 _
ELSE WasD$ = "Cannot change status during Conference!" : _
GOSUB 33210 : _
GOTO 33970
ZSubParm = 3
CALL FileLock
IF ZSubParm = -1 THEN _
GOTO 33970
CALL OpenMsg
FIELD 1,128 AS ZMsgRec$
GET 1,ZNodeRecIndex
MID$(ZMsgRec$,FieldPosition,2) = STR$(ChangeValue)
CALL SaveProf (2)
FIELD 1, 128 AS ZMsgRec$
33970 IF ZFunctionKey < 22 AND ZFunctionKey > 15 THEN _ 'DGS-L25MOD
MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60 : _ 'DGS-L25
CALL Line25 'DGS-L25
END SUB 'DGS-L25MOD
33990 ' $SUBTITLE: 'PageUp - Display user profile to Sysop'
' $PAGE
'
' NAME -- PageUp
'
' INPUTS -- PARAMETER MEANING
' ZActiveUserName$ CURRENT USER NAME
' ZDnlds # OF FILES DOWNLOADED
' ZExpirationDate$ REGISTRATION EXPIRATION
' ZLastDateTimeOnSave$ Last DATE & TIME ON SYSTEM
' ZLastMsgRead Last MESSAGE READ BY USER
' ZPswdSave$ USERS PASSWORD
' ZTimesLoggedOn TIMES USER HAS LOGGED ON
' ZUplds # OF FILES UPLOADED
' ZUserSecSave USERS SECURITY LEVEL
'
' OUTPUTS -- ZMsgRec$
'
SUB PageUp STATIC
CALL LPrnt (" ",1)
CALL LPrnt ("USER NAME : " + ZActiveUserName$,1)
CALL LPrnt ("SECURITY :" + STR$(ZUserSecSave),1)
CALL LPrnt ("PASSWORD :" + ZPswdSave$,1)
CALL LPrnt ("READ MSG. :" + STR$(ZLastMsgRead),1)
CALL LPrnt ("TIMES ON :" + STR$(ZTimesLoggedOn),1)
CALL LPrnt ("LAST ON :" + ZLastDateTimeOnSave$,1)
CALL LPrnt ("DOWNLOADS :" + STR$(ZDnlds),1)
CALL LPrnt ("UPLOADS :" + STR$(ZUplds),1)
CALL LPrnt ("DL-BYTES :" + STR$(ZDLBytes!),1) 'Pe 02/05/90
CALL LPrnt ("UL-BYTES :" + STR$(ZULBytes!),1)
IF ZRestrictByDate THEN _
CALL LPrnt ("EXPIRATION: " + ZExpirationDate$,1)
CALL LPrnt ("User's Profile",1)
END SUB
35000 ' $SUBTITLE: 'FlushKeys - Completely flush all user input'
' $PAGE
'
' NAME -- FlushKeys
'
SUB FlushKeys STATIC
CALL FlushCom (ZWasY$)
ZAnsIndex = 0
ZLastIndex = 0
REDIM ZUserIn$(ZMsgDim)
END SUB
41008 ' $SUBTITLE: 'CheckTimeRemain - Kicks off if no time remaining'
' $PAGE
'
' NAME -- CheckTimeRemain
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
' ZSecsUsedSession! TIME USED IN SECONDS
' ZSubParm -1 IF No TIME LEFT
'
SUB CheckTimeRemain (MinsRemaining) STATIC
CALL TimeRemain (MinsRemaining)
IF ZBypassTimeCheck THEN _
EXIT SUB
IF MinsRemaining <= 0 THEN _
ZSubParm = -1
IF DGSCurrHour = 1 THEN _
CALL QuickTPut ("Sorry " + ZFirstName$ + _ 'DGS-BRM
" Board Access Restricted During Current Hours",1) 'DGS-BRM
END SUB
41010 ' $SUBTITLE: 'TimeRemain - calculates time remaining in a session'
' $PAGE
'
' NAME -- TimeRemain
'
' INPUTS -- PARAMETER MEANING
' ZUserLogonTime! WHEN DID THE CALLER GET HERE
' ZSecsPerSession! HOW LONG MAY THE CALLER STAY ON
' ZTimeToDropToDos! WHEN ARE WE DOING OUR DAILY EVENT
' ZBypassTimeCheck DO WE CARE HOW LONG THEY CAN STAY
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
' ZSecsUsedSession! TIME USED IN SECONDS
'
SUB TimeRemain (MinsRemaining) STATIC
TOA! = FRE("A")
IF ZBypassTimeCheck THEN _
MinsRemaining = ZSecsPerSession! / 60 : _
EXIT SUB
CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
IF ZTimeToDropToDos! = 0 OR _
ZOldDate$ = DATE$ THEN _
GOTO 41020
CALL CheckTime (ZTimeToDropToDos!, HowMuchTimeLeft!, 1)
IF (ZSecsPerSession! - ZSecsUsedSession!) _
> HowMuchTimeLeft! THEN _
ZSecsPerSession! = HowMuchTimeLeft! + _
ZSecsUsedSession! : _
IF NOT ToldShort THEN _
ToldShort = ZTrue : _
ZOutTxt$ = "Time shortened for scheduled event" : _
CALL RingCaller : _ 'DGS-014Mod
CALL UpdtCalr ("Notified - Time Cut for Scheduled Event",1) 'DGS-014
41020 MinsRemaining = (ZSecsPerSession! - ZSecsUsedSession!) / 60
END SUB
41032 ' $SUBTITLE: 'DispTimeRemain - Display users time remaining'
' $PAGE
'
' NAME -- DispTimeRemain
'
' INPUTS -- PARAMETER MEANING
' MinsRemaining
'
' OUTPUTS -- PARAMETER MEANING
' MinsRemaining TIME IN MINUTES LEFT IN SESSION
'
SUB DispTimeRemain (MinsRemaining) STATIC
CALL TimeRemain (MinsRemaining)
CALL QuickTPut1 (STR$(MinsRemaining) + " min left")
CALL Line25 'DGS-008
END SUB
41498 ' $SUBTITLE: 'AMorPM - give time of day in AM/PM format'
' $PAGE
'
' NAME -- AMorPM
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- ZCurDate$ CURRENT DATE (MM-DD-YY)
' ZTime$ CURRENT TIME (I.E. 1:13 PM)
'
' PURPOSE -- To set the time and date and
' describe the time as "AM" or "PM."
'
SUB AMorPM STATIC
'
'
' * CALCULATE CURRENT TIME FOR AM OR PM
'
'
41500 ZCurDate$ = DATE$
ZCurDate$ = LEFT$(ZCurDate$ ,6) + _
RIGHT$(ZCurDate$ ,2)
41510 ZTime$ = TIME$
IF VAL(MID$(ZTime$,1,2)) = 12 THEN _
MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))),2) : _
ZTime$ = LEFT$(ZTime$,5) + _
" PM" : _
EXIT SUB
IF VAL(MID$(ZTime$,1,2)) > 11 THEN _
MID$(ZTime$,1,2) = RIGHT$(STR$(VAL(MID$(ZTime$,1,2))-12),2) : _
ZTime$ = LEFT$(ZTime$,5) + _
" PM" : _
EXIT SUB
ZTime$ = LEFT$(ZTime$,5) + _
" AM"
END SUB
42000 ' $SUBTITLE: 'Carrier - sub to monitor carrier on comm. port'
' $PAGE
'
' NAME -- Carrier
'
' INPUTS -- PARAMETER MEANING
' ZAutoLogoffReq -1 if in autologoff request
'
' OUTPUTS -- ZSubParm = 0 CONTINUE
' ZSubParm = -1 TERMINATE (No Carrier)
'
' PURPOSE -- To test whether should continue in RBBS. Reasons
' NOT to continue are: autologoff, out of time, or
' carrier dropped.
'
SUB Carrier STATIC
IF ZAutoLogoffReq THEN _
IF NOT ZSuspendAutologoff THEN _
ZSubParm = -1 : _
EXIT SUB
CALL CheckCarrier
END SUB
42005 ' $SUBTITLE: 'CheckCarrier - monitors carrier on comm. port'
' $PAGE
'
' NAME -- CheckCarrier
'
' INPUTS -- PARAMETER MEANING
' ZLocalUser = 0 REMOTE USER
' ZLocalUser = -1 LOCAL KEYBOARD USER
' ZModemStatusReg ADDRESS OF THE COMMUNI-
' CATIONS PORT'S REGISTER
' ZSubParm = -9 DON'T WRITE TO CALLERS
' ZSubParm = -10 SAME AS -9, BUT DON'T
' DELAY
'
' OUTPUTS -- ZSubParm = 0 Carrier STILL PRESENT
' ZSubParm = -1 Carrier NOT PRESENT
'
' PURPOSE -- To test if carrier is present (i.e. the user
' is still on line). Ignores whether in autologoff.
'
SUB CheckCarrier STATIC
IF ZSubParm = -1 THEN _
EXIT SUB
Speedy = ZSubParm
ZSubParm = 0
IF ZLocalUser THEN _
EXIT SUB
42010 IF INP(ZModemStatusReg) > 127 THEN _
EXIT SUB
'
'
' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR Carrier
' * DETECT. SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE Carrier,
' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.
'
'
42015 IF Speedy = -10 THEN _
GOTO 42020
CALL DelayTime (ZModemInitWaitTime)
IF INP(ZModemStatusReg) > 127 THEN _
EXIT SUB
42020 ZSubParm = -1
IF Speedy < -8 THEN _
EXIT SUB
IF AlreadyWritten = -9 THEN _
EXIT SUB
CALL TakeOffHook
ZModemOffHook = -1
AlreadyWritten = -9
CALL UpdtCalr ("Carrier dropped",1)
END SUB
43004 ' $SUBTITLE: 'AskGraphics -- sub to ask users graphic preference'
' $PAGE
'
' NAME -- AskGraphics
'
' INPUTS -- PARAMETER MEANING
' ZUserGraphicDefault$ USER Graphic DEFAULT
'
' OUTPUTS --
'
' PURPOSE -- To determine users graphics default
'
SUB AskGraphics STATIC
IF ZExpertUser THEN _
GOTO 43007
43006 ZFileName$ = ZHelp$(9)
CALL BufFile (ZFileName$,WasX)
IF ZSubParm = -1 THEN _
EXIT SUB
43007 CALL QuickTPut1 ("GRAPHICS for text files and menus")
ZOutTxt$ = "Change from " + MID$("NAC",ZWasGR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + ZPressEnterExpert$
ZSubParm = 1
ZTurboKey = -ZTurboKeyUser
CALL TGet
IF ZSubParm = -1 THEN _
EXIT SUB
IF ZWasQ = 0 THEN _
CALL QuickTPut1 ("Unchanged") : _
EXIT SUB
CALL AllCaps (ZUserIn$(1))
ZWasGR = INSTR("NAC",ZUserIn$(1))
IF ZWasGR = 2 AND NOT ZEightBit THEN _
CALL QuickTPut1 ("Ascii unavailable. Requires 8 bit") : _
GOTO 43007
IF ZWasGR = 0 THEN _
GOTO 43006
ZWasGR = ZWasGR - 1
CALL SetGraphic (ZWasGR,ZUserGraphicDefault$)
END SUB
'
43031 ' $SUBTITLE: 'GraphicX - sub to find graphic version of a file'
' $PAGE
'
' NAME -- GraphicX
'
' INPUTS -- PARAMETER MEANING
' Default$ USERS Graphic DEFAULT
' ZWasGR WHETHER GRAPHICS ARE AVAILABLE
' FilName$ FILE TO CHECK
' FileNum # of file to use
'
' OUTPUTS -- FilName$ SUBSTITUTES NAME OF GRAPHICS
' FILE (IF IT EXISTS).
'
' PURPOSE -- Checks whether there is a graphics version of
' a file, based on users graphics perference.
' Sets file name to graphics file if it exists,
' Otherwise leaves file name intact. Returns file
' name to use.
'
SUB GraphicX (Default$,FilName$,FileNum) STATIC
ZOK = ZFalse
IF ZWasGR THEN _
CALL BreakFileName (FilName$,DR$,WasX$,Extension$,ZTrue) : _
IF LEN(WasX$) < 8 THEN _
ZWasDF$ = DR$ + _
WasX$ + _
Default$ + _
Extension$ : _
CALL FINDITX (ZWasDF$,FileNum) : _
IF ZOK THEN _
FilName$ = ZWasDF$ : _
IF Default$ = "C" THEN _
ZLinesPrinted = 0
IF NOT ZOK THEN _
CALL FINDITX (FilName$,FileNum)
END SUB
' Sets Graphic version but uses file # 2 always
SUB Graphic (Default$,FilName$) STATIC
CALL GraphicX (Default$,FilName$,2)
END SUB
43068 ' $SUBTITLE: 'SaveProf - subroutine to read a user profile'
' $PAGE
'
' NAME -- SaveProf
'
' INPUTS -- PARAMETER MEANING
' ZBPS
' ZEightBit
' ZExitToDoors
' ZWasGR
' ZMsgRec$
' ZNodeRecIndex
' ZSysop
' ZUpperCase
' ZTimeLoggedOn$
' ZPrivateDoor
' ZReliableMode
'
' OUTPUTS -- NONE
'
' PURPOSE -- Saves a user's options and communications parameters
' in the node record when a user exits to a "door" so
' that he is in the same status as when he exited.
'
SUB SaveProf (IParm) STATIC
ON IParm GOTO 43070,43080
43070 ZActiveMessageFile$ = ZOrigMsgFile$
ZSubParm = 3
CALL FileLock
CALL OpenMsg
FIELD 1, 128 AS ZMsgRec$
GET 1,ZNodeRecIndex
IF ZGlobalSysop THEN _
MID$(ZMsgRec$,1,30) = "SYSOP" + SPACE$(25)
MID$(ZMsgRec$,40,2) = STR$(ZExitToDoors)
MID$(ZMsgRec$,42,2) = STR$(ZEightBit)
MID$(ZMsgRec$,44,2) = STR$(ZBPS)
MID$(ZMsgRec$,46,2) = STR$(ZUpperCase)
MID$(ZMsgRec$,48,5) = MKS$(ZNumDnldBytes!) + MID$(STR$(-ZBatchTransfer),2) 'Pe 02/16/90
MID$(ZMsgRec$,53,2) = STR$(ZWasGR)
MID$(ZMsgRec$,55,2) = STR$(ZSysop)
MID$(ZMsgRec$,65,3) = CHR$(VAL(LEFT$(ZTimeLoggedOn$,2))) + _
CHR$(VAL(MID$(ZTimeLoggedOn$,4,2))) + _
CHR$(VAL(MID$(ZTimeLoggedOn$,7,2)))
MID$(ZMsgRec$,72,2) = STR$(ZPrivateDoor)
MID$(ZMsgRec$,74,1) = MID$(STR$(ZTransferFunction),2,1)
MID$(ZMsgRec$,75,1) = ZWasFT$
MID$(ZMsgRec$,113,2) = MKI$(CINT(ZTimeCredits!)/60)
MID$(ZMsgRec$,79,8) = LEFT$(ZDooredTo$+" ",8)
MID$(ZMsgRec$,91,2) = STR$(ZReliableMode)
CALL BreakFileName (ZCurPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZFalse)
MID$(ZMsgRec$,93,8) = ZUserIn$ + SPACE$(8 - LEN(ZUserIn$))
IF ZLocalUser THEN _
ZWasZ$ = ZCarriageReturn$ + ZCarriageReturn$ _ ' KG030601
ELSE ZWasZ$ = " 0" ' KG030601
MID$(ZMsgRec$,101,2) = ZWasZ$ ' KG030601
MID$(ZMsgRec$,103,2) = STR$(ZLocalUserMode) ' KG030601
ZConfName$ = LEFT$(ZConfName$,INSTR(ZConfName$ + " "," ") - 1)
MID$(ZMsgRec$,105,8) = ZConfName$ + SPACE$(8 - LEN(ZConfName$))
MID$(ZMsgRec$,115,1) = MID$(STR$(ZAutoLogoffReq),2,1)
MID$(ZMsgRec$,117,2) = STR$(ZMenuIndex)
MID$(ZMsgRec$,119,2) = LEFT$(DATE$,2)
MID$(ZMsgRec$,121,2) = MID$(DATE$,4,2)
MID$(ZMsgRec$,123,2) = RIGHT$(DATE$,2)
MID$(ZMsgRec$,125,2) = LEFT$(TIME$,2)
MID$(ZMsgRec$,127,2) = MID$(TIME$,4,2)
' *** Save additional parameters for door restoral
CALL OpenOutW (ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
CALL PrintWorkA (STR$(ZLimitMinsPerSession))
CLOSE 2
43080 PUT 1,ZNodeRecIndex
ZSubParm = 2
CALL FileLock
CALL OpenMsg
END SUB
44000 ' $SUBTITLE: 'ReadProf - subroutine to restore a user profile'
' $PAGE
'
' NAME -- ReadProf
'
' INPUTS -- PARAMETER MEANING
' ZNodeRecIndex NODE RECORD TO USE
' ZSysopPswd1$ Sysop'S PSEUDONYM 1
' ZSysopPswd2$ Sysop'S PSEUDONYM 2
'
' OUTPUTS -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
' UPON EXITING RBBS-PC TO A "DOOR"
'
' PURPOSE -- Reset a user's options and communications parameters
' that were saved in the node record when a user exited
' to a "door" so that he is in the same status as when
' he exited.
'
SUB ReadProf STATIC
FIELD 1, 128 AS ZMsgRec$
GET 1,ZNodeRecIndex
ZReliableMode = VAL(MID$(ZMsgRec$,91,2))
MID$(ZMsgRec$,40,2) = "00"
ZEightBit = VAL(MID$(ZMsgRec$,42,2))
ZBPS = VAL(MID$(ZMsgRec$,44,2))
CALL CommInfo
ZBaudTest! = VAL(MID$(ZBaudRates$,(-5 * ZBPS),5))
ZUpperCase = VAL(MID$(ZMsgRec$,46,2))
ZNumDnldBytes! = CVS(MID$(ZMsgRec$,48,4)) 'Pe 02/16/90
ZBatchTransfer = (MID$(ZMsgRec$,52,1) = "1")
ZWasGR = VAL(MID$(ZMsgRec$,53,2))
HourLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,65,1))),2),2)
MinLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,66,1))),2),2)
SecLoggedOn$ = RIGHT$("0"+MID$(STR$(ASC(MID$(ZMsgRec$,67,1))),2),2)
ZTimeLoggedOn$ = HourLoggedOn$ + _
":" + _
MinLoggedOn$ + _
":" + _
SecLoggedOn$
ZTransferFunction = VAL(MID$(ZMsgRec$,74,1))
ZWasFT$ = MID$(ZMsgRec$,75,1)
ZTimeCredits! = 60!*CVI(MID$(ZMsgRec$,113,2)) 'KKG030901
ZDooredTo$ = MID$(ZMsgRec$,79,8)
CALL Trim (ZDooredTo$)
IF ZExitToDoors AND ZDooredTo$ <> "" THEN _
CALL OpenWork (2,ZDoorsDef$) : _
IF ZErrCode = 0 THEN _
CALL ReadParms (ZOutTxt$(),8,1) : _
WHILE ZErrCode = 0 AND ZOutTxt$(1) <> ZDooredTo$ : _
CALL ReadParms (ZOutTxt$(),8,1) : _
WEND : _
IF ZOutTxt$(1) = ZDooredTo$ THEN _
ZDoorSkipsPswd = (ZOutTxt$(6) <> "Y") : _
CALL BufFile (ZOutTxt$(7),WasX)
ZErrCode = 0
ZMenuIndex = VAL(MID$(ZMsgRec$,117,2))
ZCurPUI$ = MID$(ZMsgRec$,93,8)
CALL Remove (ZCurPUI$," ")
IF ZCurPUI$ <> "" THEN _
CALL BreakFileName (ZMainPUI$,ZOutTxt$,ZUserIn$,ZWasZ$,ZTrue) : _
ZCurPUI$ = ZOutTxt$ + ZCurPUI$ + ZWasZ$
ZCustomPUI = (ZCurPUI$ <> "")
ZLocalUser = (MID$(ZMsgRec$,101,2) = ZCarriageReturn$ + ZCarriageReturn$) ' KG030601
ZLocalUserMode = VAL(MID$(ZMsgRec$,103,2))
ZHomeConf$ = MID$(ZMsgRec$,105,8)
ZAutoLogoffReq = (VAL(MID$(ZMsgRec$,115,1)) <> 0)
CALL Trim (ZHomeConf$)
IF ZRequiredRings > 0 AND _
INSTR(ZModemInitCmd$,"S0=255") THEN _
COLOR 7,0,0 _
ELSE COLOR ZFG,ZBG,ZBorder
IF ZLocalUserMode THEN _
GOTO 44003
CALL SetBaud
44003 ZUserLogonTime! = VAL(HourLoggedOn$) * 3600! + _ ' KK030901
VAL(MinLoggedOn$) * 60! + _ ' KK030901
VAL(SecLoggedOn$)
HourLoggedOn$ = ""
MinLoggedOn$ = ""
SecLoggedOn$ = ""
IF ZMinsPerSession < 1 THEN _
ZMinsPerSession = 3
IF NOT ZEightBit THEN _
OUT ZLineCntlReg,&H1A
IF LEFT$(ZMsgRec$,7) = "SYSOP " THEN _
ZFirstName$ = ZSysopPswd1$ : _
ZActiveUserName$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
ELSE ZFirstNameEnd = INSTR(ZMsgRec$," ") : _
ZLastNameEnd = INSTR(ZFirstNameEnd + 1,ZMsgRec$ + " "," ") : _
ZFirstName$ = LEFT$(ZMsgRec$,ZFirstNameEnd-1) : _
ZLastName$ = MID$(ZMsgRec$,ZFirstNameEnd + 1,ZLastNameEnd - (ZFirstNameEnd + 1)) : _
ZActiveUserName$ = MID$(ZFirstName$ + " " + ZLastName$,1,31)
ZWasZ$ = ZFirstName$
CALL OpenWork (2,ZNodeWorkDrvPath$+"DRST"+ZNodeFileID$+".DEF")
CALL ReadDir (2,1)
ZLimitMinsPerSession = VAL (ZOutTxt$)
CLOSE 2
END SUB
44020 ' $SUBTITLE: 'CommInfo - sub for variable of users baud/parity'
' $PAGE
'
' NAME -- CommInfo
'
' INPUTS -- PARAMETER MEANING
' ZBPS BAUD RATE INDICATOR
' ZEightBit INDICATE FOR N/8/1
'
' OUTPUTS -- ZBaudParity$
'
' PURPOSE -- Create a string that shows a users baud rate and parity
'
SUB CommInfo STATIC
'
'
' * DETERMINE BAUD AND PARITY
'
'
IF ZReliableMode THEN _
ReliableMode$ = "-R," _
ELSE ReliableMode$ = ","
ZBaudParity$ = MID$(ZBaudRates$,(-5 * ZBPS),5) + _
" BAUD" + _
ReliableMode$ + _
MID$("N,8,1E,7,1",6 + 5 * ZEightBit,5)
ZBaudTest! = VAL(ZBaudParity$)
END SUB
50495 ' $SUBTITLE: 'DelayTime - sub to wait number of seconds specified'
' $PAGE
'
' NAME -- DelayTime
'
' INPUTS -- PARAMETER MEANING
' DelaySecs NUMBER OF SECONDS TO DELAY
' (0 TO 3,600)
'
' OUTPUTS -- NONE
'
' PURPOSE -- To wait the number of seconds indicated before
' returning control to the calling routine.
'
SUB DelayTime (DelaySecs) STATIC
IF DelaySecs < 1 THEN _
EXIT SUB
ZDelay! = TIMER + DelaySecs
50500 CALL CheckTime(ZDelay!, TempElapsed!, 1)
IF TempElapsed! > 0 THEN _
GOTO 50500
END SUB
52070 ' $SUBTITLE: 'ModemPut - sub to write modem commands to modem'
' $PAGE
'
' SUBROUTINE NAME -- ModemPut
'
' INPUT PARAMETERS -- PARAMETER MEANING
' Strng$ MODEM COMMAND
' ZCmdsBetweenRings INDICATOR TO WAIT FOR
' MODEM TO STOP RINGING
' BEFORE ISSUING COMMANDS
' ZDumbModem INDICATOR THAT MODEM WOULD
' NOT UNDERSTAND COMMANDS
'
' OUTPUT PARAMETERS -- NONE
'
' SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
'
SUB ModemPut (Strng$) STATIC
'
'
' * SEND MODEM COMMAND
'
'
IF ZDumbModem THEN _
EXIT SUB
IF NOT ZCmdsBetweenRings OR _
NOT (INP(ZModemStatusReg) AND &H40) THEN _
GOTO 52080
ConnectDelay! = TIMER + 7
52072 IF (INP(ZModemStatusReg) AND &H40) > 0 THEN _
CALL CheckTime(ConnectDelay!, TempElapsed!, 1) : _
IF ZSubParm = 2 THEN _
GOTO 52080
GOTO 52072
52080 CALL DelayTime (ZModemCmdDelayTime)
WasX$ = " "
FOR WasI = 1 TO LEN(Strng$)
LSET WasX$ = MID$(Strng$,WasI,1)
ON INSTR("{~",WasX$) GOTO 52082,52084
GOTO 52085
52082 LSET WasX$ = ZCarriageReturn$
GOTO 52085
52084 CALL DelayTime (1)
GOTO 52086
52085 CALL CommPut (WasX$)
52086 NEXT
CALL CommPut (ZCarriageReturn$)
END SUB
57001 ' $SUBTITLE: 'DispCall - subroutine to display callers file'
' $PAGE
'
' NAME -- DispCall
'
' INPUTS -- PARAMETER MEANING
'
' OUTPUTS -- (NONE)
'
' PURPOSE -- Displays callers file to sysops and callers
'
SUB DispCall STATIC
IF ZCallersFilePrefix$ = "" THEN _
EXIT SUB
CALL SkipLine (1)
CallersFileIndexTemp! = ZCallersFileIndex!
CLOSE 4
IF ZShareIt THEN _
OPEN ZCallersFile$ FOR RANDOM SHARED AS #4 LEN=64 _
ELSE OPEN "R",4,ZCallersFile$,64
FIELD 4,64 AS ZCallersRecord$
57005 IF CallersFileIndexTemp! < 1 OR ZRet THEN _
EXIT SUB
57010 GET 4,CallersFileIndexTemp!
ZOutTxt$ = ZCallersRecord$
IF LEFT$(ZOutTxt$,3) = " " OR _
INSTR(ZOutTxt$,"on at") = 0 THEN _
GOTO 57030
57025 CallersFileIndexTemp! = CallersFileIndexTemp! - 1
GET 4,CallersFileIndexTemp!
WasZ = INSTR(ZCallersRecord$,"{")
IF WasZ < 1 OR WasZ > 15 THEN _
WasZ = 15
IF ZSysop OR _
LEFT$(ZOutTxt$,3) <> " " THEN _
ZOutTxt$ = ZOutTxt$ + LEFT$(ZCallersRecord$,WasZ - 1)
GOSUB 57100
IF ZSysop THEN _
ZOutTxt$ = MID$(ZCallersRecord$,WasZ) : _
GOSUB 57100
GOTO 57045
57030 IF ZSysop THEN _
GOSUB 57100
57045 CallersFileIndexTemp! = CallersFileIndexTemp! -1
GOTO 57005
57100 IF INSTR(ZOutTxt$,"LOGON DENIED") THEN _
IF NOT ZSysop THEN _
RETURN
CALL QuickTPut1 (ZOutTxt$)
CALL AskMore ("",ZTrue,ZTrue,WasX,ZFalse)
IF ZNo OR ZSubParm = -1 THEN _
EXIT SUB
RETURN
END SUB
58050 ' $SUBTITLE: 'AllCaps - sub to convert string to upper case'
' $PAGE
'
' NAME -- AllCaps
'
' INPUTS -- PARAMETER MEANING
' ConvertField$ STRING TO MAKE UPPER CASE
'
' OUTPUTS -- ConvertField$ CONVERTED STRINGS
'
' PURPOSE -- Subroutine to convert a string to upper case
'
SUB AllCaps (ConvertField$) STATIC
IF ZTurboRBBS THEN _
CALL RBBSULC (ConvertField$) : _
EXIT SUB
FOR WasZ = 1 TO LEN(ConvertField$)
IF MID$(ConvertField$,WasZ,1) > "@" THEN _
MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) AND 223)
NEXT
END SUB
58060 ' $SUBTITLE: 'NameCaps - sub to convert name string to Proper Case'
' $PAGE
'
' NAME -- NameCaps
'
' INPUTS -- PARAMETER MEANING
' ConvertField$ STRING TO CONVERT
'
' OUTPUTS -- ConvertField$ CONVERTED STRINGS
'
' PURPOSE -- Subroutine to convert a string to Proper Case (1st char upper)
'
SUB NameCaps (ConvertField$) STATIC
CALL AllCaps(ConvertField$)
FOR WasZ = 2 TO LEN(ConvertField$)
IF MID$(ConvertField$,WasZ,1) > "@" AND _
MID$(ConvertField$,WasZ,1) < "[" AND _
MID$(ConvertField$,WasZ-1,1) <> " " THEN _
MID$(ConvertField$,WasZ,1) = CHR$(ASC(MID$(ConvertField$,WasZ,1)) OR 32)
NEXT
END SUB
58070 ' $SUBTITLE: 'CheckTime - sub to see how much time is remaining'
' $PAGE
'
' NAME -- CheckTime
'
' INPUTS -- PARAMETER MEANING
' TargetTime TARGET TIME
' ChectimeOption 1 = TELL US TIME REMAINING BETWEEN CURRENT
' TIME AND TargetTime
' 2 = TELL US TIME ELAPSED BETWEEN TargetTime
' AND CURRENT TIME
'
' OUTPUTS -- PARAMETER MEANING
' TimeRemaining! POSITIVE OR NEGATIVE NUMBER INDICATING
' TIME REMAINING OR ELAPSED. VALUE MAY BE
' TESTED FOR "TIME EXPIRED". NEGATIVE
' OR ZERO, AND THE TIME HAS BEEN REACHED.
' ELAPSED TIME CAN BE 0 TO 86400 (24 HRS)
' TIME REMAINING CAN BE 0 TO 43200 OR
' -43200 TO 0 (+ OR - 12 HRS)
' ZSubParm (Option 1 ONLY!)
' 1 = Time REMAINING is > 0
' 2 = Time REMAINING is <= 0
'
'
' PURPOSE -- Subroutine to provide time measurement functions. Will
' determine whether a target time has been reached, how much
' time is remaining, or how much time has elapsed.
'
SUB CheckTime (TargetTime!, TimeRemaining!, CkOption) STATIC
IF TargetTime! > 86400 THEN _
TestTime! = 86400 : _
OverTime! = TargetTime! - 86400 _
ELSE _
TestTime! = TargetTime! : _
OverTime! = 0
TimeRemaining! = (TestTime! - TIMER) + OverTime!
IF CkOption = 2 THEN GOTO 58072
IF TimeRemaining! < -43200 THEN _
TimeRemaining! = TimeRemaining! + 86400
IF TimeRemaining! > 43200 THEN _
TimeRemaining! = TimeRemaining! - 86400
IF TimeRemaining! >= 0 THEN _
ZSubParm = 1 _
ELSE _
ZSubParm = 2
EXIT SUB
58072 IF TimeRemaining! > 0 THEN _
TimeRemaining! = 86400 - TimeRemaining! _
ELSE _
TimeRemaining! = -(TimeRemaining!)
END SUB
58080 ' $SUBTITLE: 'HashRBBS - sub to determine where to look for user'
' $PAGE
'
' NAME -- HashRBBS
'
' INPUTS -- PARAMETER MEANING
' StringToHash$ USER NAME TO LOCATE
' MaxPosition MAXIMUM # USERS
'
' OUTPUTS -- PrimeHash WHERE TO LOOK First
' SecondHash LOOK THIS FAR AHEAD
'
' PURPOSE -- Where to look for a user in users file
' Look first at prime position, then add
' SecondHash until find or find unused record
'
SUB HashRBBS (StringToHash$,MaxPosition,PrimeHash,SecondHash) STATIC
SecondHash = (ASC(MID$(StringToHash$,2,1)) * 10 + 7) MOD _
MaxPosition
PrimeHash = _
((ASC(StringToHash$) * 100 + _
ASC(MID$(StringToHash$,(LEN(StringToHash$) / 2) + .1,1)) * _
10 + _
ASC(RIGHT$(StringToHash$,1))) _
MOD MaxPosition) + 1
END SUB
58100 ' $SUBTITLE: 'SetOpts - sub to set prompts based on user security'
' $PAGE
'
' NAME -- SetOpts
'
' INPUTS -- PARAMETER MEANING
' First POSITION WHERE START LOOKING
' Last POSITION WHERE QUIT LOOKING
' ZUserSecLevel SECURITY OF USER
'
' OUTPUTS -- Options$ LIST OF COMMANDS USER CAN DO
'
' PURPOSE -- String together what commands user can do in a section
'
SUB SetOpts (Options$,InvalidOptions$,First,Last) STATIC
Options$ = ""
InvalidOptions$ = ""
FOR WasI = First TO Last
IF ZUserSecLevel < ZOptSec(WasI) THEN _
InvalidOptions$ = InvalidOptions$ + _
MID$(ZAllOpts$,WasI,1) _
ELSE IF MID$(ZAllOpts$,WasI,1) <> " " THEN _
Options$ = Options$ + _
MID$(ZAllOpts$,WasI,1)
NEXT
CALL SortString (Options$)
CALL SortString (InvalidOptions$)
END SUB
58110 ' $SUBTITLE: 'CheckNewBul - sub to check whether got new bulletins'
' $PAGE
'
' NAME -- CheckNewBul
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Last DATE OF LOGON
' FORMAT MM/DD/YY
' ZActiveBulletins # OF BULLETING
' ZBulletinPrefix$ FILESPEC FOR BULLETINS
'
' OUTPUTS -- NumNewBullets NUMBER OF NEW BULLETINS
' NewBullets$ LIST OF NEW BULLET #'S
' ZWasQ WHERE Last BULLETIN STORED
' IN ZUserIn$()
' ZUserIn$() BULLETINS #'S THAT ARE NEW
' (2,3,4,...)
'
' PURPOSE -- Checks how many bulletins have system date
' at or later than date caller last logged on
'
SUB CheckNewBul (LastOn$,NumNewBullets,NewBullets$) STATIC
IF ZExitToDoors OR ZBulletinPrefix$ = ZPrevPrefix$ THEN _
EXIT SUB
ZPrevPrefix$ = ZBulletinPrefix$
NumNewBullets = 0
NewBullets$ = ": "
BaseDate# = VAL(MID$(LastOn$,4,2)) + (100 * VAL(MID$(LastOn$,1,2))) + _
(10000# * (1900 + VAL(MID$(LastOn$,7,2))))
CALL FindIt (ZBulletinPrefix$ + ".FCK")
WasX = 0
CALL QuickTPut ("For by grace are ye saved through faith",0) ' Bh
IF ZOK THEN _
WHILE NOT EOF(2) : _
LINE INPUT #2,WasBN$ : _
GOSUB 58112 : _
WEND _
ELSE FOR WasI = 1 TO ZActiveBulletins : _
WasBN$ = MID$(STR$(WasI),2) : _
GOSUB 58112 : _
NEXT
ZWasQ = NumNewBullets + 1
IF NumNewBullets < 1 THEN _
NewBullets$ = ""
' CALL SkipLine (1)
CALL WipeLine (35)
ZOutTxt$ = STR$(NumNewBullets) + _
" NEW BULLETIN(S) since last call" + _
NewBullets$
CALL QuickTPut1 (ZOutTxt$)
EXIT SUB
58112 IF WasBN$ = "N" THEN _
WasX$ = ZNewsFileName$ + CHR$(0) _
ELSE WasX$ = ZBulletinPrefix$ + WasBN$ + CHR$(0)
CALL MarkTime (WasX)
CALL RBBSFind (WasX$,WasIX,Year,WasMM,WasDD)
IF WasIX = 0 THEN _
FDate# = WasDD + (100 * WasMM) + (10000# * (Year + 1980)) : _
IF BaseDate# <= FDate# THEN _
NumNewBullets = NumNewBullets + 1 : _
ZUserIn$(NumNewBullets + 1) = WasBN$ : _
NewBullets$ = NewBullets$ + _
" " + _
WasBN$
RETURN
END SUB
58120 ' $SUBTITLE: 'SortString - sub to sort characters in a string'
' $PAGE
'
' NAME -- SortString
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO SORT
'
' OUTPUTS -- Strng$ SORTED STRING
'
' PURPOSE -- Sorts characters in passed string.
'
SUB SortString (Strng$) STATIC
Sort0 = LEN(Strng$)
Sort1 = Sort0
WasX$ = "!"
58122 Sort1 = Sort1\2
IF Sort1 = 0 THEN _
EXIT SUB
Sort2 = Sort0 - Sort1
FOR Sort3 = 1 TO Sort2
Sort4 = Sort3
58124 Sort5 = Sort4 + Sort1
IF MID$(Strng$,Sort4,1) > MID$(Strng$,Sort5,1) THEN _
LSET WasX$ = MID$(Strng$,Sort4,1) : _
MID$(Strng$,Sort4,1) = MID$(Strng$,Sort5,1) : _
MID$(Strng$,Sort5,1) = WasX$ : _
Sort4 = Sort4 - Sort1 : _
IF Sort4 > 0 THEN _
GOTO 58124
NEXT
GOTO 58122
END SUB
58130 ' $SUBTITLE: 'AddCommas - sub to format commands in command prompt'
' $PAGE
'
' NAME -- AddCommas
'
' INPUTS -- PARAMETER MEANING
' Strng$ STRING TO REPLACE
'
' OUTPUTS -- Strng$ REPLACED STRING
'
' PURPOSE -- Inserts commands between each letter in Strng$
' and encloses in pointed brackets
'
SUB AddCommas (Strng$) STATIC
WasL = LEN(Strng$)
IF WasL < 1 THEN _
EXIT SUB
LSET ZLineMes$ = " <" + _
LEFT$(Strng$,1)
FOR WasK = 2 TO WasL
MID$(ZLineMes$,2 * WasK,2) = "," + _
MID$(Strng$,WasK,1)
NEXT
Strng$ = LEFT$(ZLineMes$,2 * WasL + 1) + _
">"
END SUB
58140 ' $SUBTITLE: 'LoadNew - subroutine to get latest uploads'
' $PAGE
'
' NAME -- LoadNew
'
' INPUTS -- PARAMETER MEANING
' ZUpldDir$ LIST OF FILES UPLOADED
'
' OUTPUTS -- ZOutTxt$ LATEST UPLOADS
'
' PURPOSE -- Loads table of most recent number of uploads by date
'
SUB LoadNew (Ara(2)) STATIC
IF ZFMSDirectory$ = "" THEN _
EXIT SUB
ZPrevBase$ = ""
IF PrevLoadNew$ = ZFMSDirectory$ THEN _
Ara(1,1) = 0 : _
EXIT SUB
PrevLoadNew$ = ZFMSDirectory$
CALL OpenFMS (LastRec)
' FIELD 2, 23 AS PreDate$, _
' 2 AS WasMM$, _
' 1 AS Fill1$, _
' 2 AS WasDD$, _
' 1 AS Fill2$, _
' 2 AS Year$, _
' (2 + ZMaxDescLen) AS Fill3$, _
' 3 AS Category$, _
' 2 AS Fill4$
FIELD 2, 20 AS PreDate$, _ ' Bh 082790
2 AS WasMM$, _
2 AS WasDD$, _
2 AS Year$, _
(1 + ZMaxDescLen) AS Fill1$, _
3 AS Category$, _
2 AS Fill2$
MaxRecs = UBOUND(Ara,1)
IF MaxRecs < 1 THEN _
MaxRecs = 1 _
'ELSE IF MaxRecs > 23 THEN _
' MaxRecs = 23
WasL = 0
WasK = LastRec
WHILE WasK > 0 AND WasL < MaxRecs
GET #2,WasK
IF INSTR("\= ",LEFT$(PreDate$,1)) > 0 THEN _
GOTO 58142
IF (ZCanDnldFromUp OR Category$ <> ZDefaultCatCode$) THEN _
WasL = WasL + 1 : _
Ara(WasL,1) = 372! * (VAL(Year$) - 80!) + 31! * VAL(WasMM$) + VAL(WasDD$) ' KK030901
IF NOT ZCanDnldFromUp THEN _
WasX = ZMinSecToView _
ELSE IF Category$ = "***" THEN _
WasX = ZSysopSecLevel _
ELSE IF Category$ = ZDefaultCatCode$ THEN _
WasX = ZMinSecToView _
ELSE WasX = ZOptSec(19)
Ara(WasL,2) = WasX
58142 WasK = WasK - 1
WEND
CLOSE 2
END SUB
58150 ' $SUBTITLE: 'CountNewFiles - sub to count how many files new'
' $PAGE
'
' NAME -- CountNewFiles
'
' INPUTS -- PARAMETER MEANING
' LastOn$ Date of last logon
' UPLDS$ Latest uploads
'
' OUTPUTS -- NumNewFiles How many after last logon
' RptPrefix$ Set to "Over " if ' Bh 091090
' above is a minimum
'
' PURPOSE -- Checks how many files in UPLDS$ were uploaded on or
' after date of last logon that the user can download
'
SUB CountNewFiles (LastOn$,Upld(2),NumUserFiles,RptPrefix$) STATIC
BaseDate = 372 * (VAL(MID$(LastOn$,7,2)) - 80) + _
31 * (VAL(MID$(LastOn$,1,2))) + _
VAL(MID$(LastOn$,4,2))
NumNewFiles = 1
NumUserFiles = 0
WHILE (BaseDate <= Upld(NumNewFiles,1) AND _
Upld(NumNewFiles,1) > 0 AND _
NumNewFiles < UBOUND(Upld,1))
IF ZUserSecLevel => Upld(NumNewFiles,2) THEN _
NumUserFiles = NumUserFiles + 1
NumNewFiles = NumNewFiles + 1
WEND
IF Upld(NumNewFiles,1) < 1 THEN _
NumNewFiles = NumNewFiles - 1
IF BaseDate <= Upld(NumNewFiles,1) THEN _
RptPrefix$ = "Over " _ ' Bh 091090
ELSE RptPrefix$ = ""
END SUB
58160 ' $SUBTITLE: 'CountLines - sub to determine file categories '
' $PAGE
'
' NAME -- CountLines
'
' INPUTS -- PARAMETER MEANING
' ZDirCatFile$ NAME OF THE FILE THAT HAS THE
' NUMBER OF CATEGORIES IN IT.
'
' OUTPUTS -- MaxEntries NUMBER OF FILE CATEGORIES
'
' PURPOSE -- Subroutine to count the number of categories that a
' file can be classified into.
'
SUB CountLines (MaxEntries) STATIC
CALL LinesInFile (ZDirCatFile$,MaxEntries)
MaxEntries = MaxEntries + 3
IF MaxEntries < 10 THEN _
MaxEntries = 10
END SUB
58161 ' $SUBTITLE: 'CountLines - sub to determine file categories '
' $PAGE
'
' NAME -- LinesInFile
'
' INPUTS -- PARAMETER MEANING
' FilName$ Name of file to use
'
' OUTPUTS -- LineCount Count of # of lines in file
'
' PURPOSE -- Subroutine to count the number of categories that a
' file can be classified into.
'
SUB LinesInFile (FilName$,LineCount) STATIC
CALL FindIt (FilName$)
LineCount = 0
IF ZOK THEN _
WHILE NOT EOF(2) : _
LineCount = LineCount + 1 : _
LINE INPUT #2,ZOutTxt$ : _
WEND
CLOSE 2
END SUB
58162 ' $SUBTITLE: 'InitFMS - sub to initialize file management system'
' $PAGE
'
' NAME -- InitFMS
'
' INPUTS -- PARAMETER MEANING
' ZFMSDirectory$
'
' OUTPUTS -- ZCategoryName$() ELEMENTS 1,2, POSSIBLY MORE
' ZCategoryCode$() ELEMENTS 1,2, POSSIBLY MORE
' ZCategoryDesc$() ELEMENTS 1,2, POSSIBLY MORE
' CategoryIndex COUNT OF # ELEMENTS IN THE FILE
' MANAGMENT SYSTEM
'
' PURPOSE -- Subroutine to initialize the RBBS-PC File Management System
'
SUB InitFMS (ZCategoryName$(1),ZCategoryCode$(1), _
ZCategoryDesc$(1),CategoryIndex) STATIC
Blank$ = " "
CategoryIndex = 0
IF ZFMSDirectory$ <> "" THEN _
CategoryIndex = CategoryIndex + 1 : _
CatN$ = ZCategoryName$(CategoryIndex) : _
CALL BreakFileName (ZFMSDirectory$,DrvPath$,CatN$,Extension$,ZFalse) : _
ZCategoryName$(CategoryIndex) = CatN$ : _
ZCategoryCode$(CategoryIndex) = "" : _
ZCategoryDesc$(CategoryIndex) = "All uploads"_
ELSE ZLimitSearchToFMS = ZFalse : _
EXIT SUB
IF ZLimitSearchToFMS OR ZMasterDirName$ = ZMainFMSDir$ THEN _
CategoryIndex = CategoryIndex + 1 : _
ZCategoryName$(CategoryIndex) = "ALL" : _
ZCategoryCode$(CategoryIndex) = "" : _
ZCategoryDesc$(CategoryIndex) = "All files"
CALL FindIt (ZDirCatFile$)
IF NOT ZOK THEN _
EXIT SUB
WHILE NOT EOF(2)
CALL ReadParms (ZWorkAra$(),3,1)
IF ZErrCode > 0 THEN _
ZErrCode = 0 : _
CALL PScrn (ZDirCatFile$+" invalid. Line" + STR$(CategoryIndex) + " needs 3 parms") : _
CALL DelayTime (4) _
ELSE CategoryIndex = CategoryIndex + 1 : _
ZCategoryName$(CategoryIndex) = ZWorkAra$(1) : _
ZCategoryCode$(CategoryIndex) = ZWorkAra$(2) : _
ZCategoryDesc$(CategoryIndex) = ZWorkAra$(3) : _
CatR$ = ZCategoryCode$(CategoryIndex) : _
CALL Remove (CatR$,Blank$) : _
ZCategoryCode$(CategoryIndex) = CatR$
WEND
CLOSE 2
END SUB
58165 ' $SUBTITLE: 'DispUpDir - sub to display upload direcotry'
' $PAGE
'
' NAME -- DispUpDir
'
' INPUTS -- PARAMETER MEANING
' PassedCats$ FILE "CATEGORIES" TO BE INCLUDED IN
' THE SEARCH.
' SearchString$ STRING TO SEARCH ON WITHIN THE
' FILE "CATEGORIES" SELECTED
' SearchDate$ DATE EQUAL TO OR GREATER THAN TO BE
' SEARCHED FOR WITH THE "CATEGORIES"
' AND THE STRING TO SEARCH.
' DnldFlag SET TO RECORD # OF LINE TO BEGIN
' VIEWING - 0 IF AT END
'
' OUTPUTS -- DnldFlag WHENEVER DOWNLOAD REQUESTED, SETS
' TO NEXT RECORD TO VIEW. OTHERWISE
' LEAVES AT ZERO
' PURPOSE -- Display the files that meet the criteria selected in
' RBBS-PC upload management system on the users screen.
'
SUB DispUpDir (PassedCats$,SearchString$, _
SearchDate$,DnldFlag,AbortIndex) STATIC
CALL AllCaps (SearchString$)
Blank$ = " "
ZStopInterrupts = ZFalse
ZLastIndex = 0
ZBobCount = 0 ' Bh 123190
Categories$ = "," + _
PassedCats$ + _
","
CanDnld = (ZUserSecLevel => ZOptSec(19))
ZJumpSupported = ZTrue
ZJumpSearching = ZFalse
GOSUB 58185
IF DnldFlag > 0 THEN _
UpldIndex = DnldFlag : _
DnldFlag = 0 : _
GOTO 58180
ZJumpLast$ = ""
SearchFor$ = SearchString$
ExtraPrompt$ = LEFT$(",+)xtra info",12+4*ZExpertUser) 'Pe 10/21/89
ExtraPrompt$ = ExtraPrompt$ + LEFT$(",V)iew",6+4*ZExpertUser) 'Pe 10/21/89
IF CanDnld THEN _
ExtraPrompt$ = ExtraPrompt$ + ",D)ownload"
MaxPrint = ZPageLength - 1
BelowMinSec = (ZUserSecLevel < ZMinSecToView)
ZNonStop = ZNonStop OR (ZPageLength < 1)
FMSCheckPoint = 0
WildSearch = (INSTR(SearchString$,"?") > 0) _
OR (INSTR(SearchString$,"*") > 0)
58168 UpldIndex = UpldIndex + ZUpInc
IF UpldIndex = CutoffRec THEN _
GOTO 58182
GET #2,UpldIndex
FMSCheckPoint = FMSCheckPoint + 1
ON INSTR("\* =",LEFT$(PartToPrint$,1)) GOTO 58168,58171,58170,58169
GOTO 58172
58169 CALL CheckInt (MID$(PartToPrint$,34))
IF ZUserSecLevel < ZTestedIntValue THEN _
LastOK = ZFalse : _
GOTO 58168
MID$(PartToPrint$,1,13) = MID$(PartToPrint$,2,12) + " "
ZWasA = LEN(STR$(ZTestedIntValue))
MID$(PartToPrint$,34) = MID$(PartToPrint$,34 + ZWasA) + SPACE$(ZWasA)
GOTO 58172
58170 IF ZExtendedOff THEN _
GOTO 58168 _
ELSE IF LastOK THEN _
GOTO 58175 _
ELSE IF ZJumpSearching THEN _
GOTO 58187 _
ELSE IF SearchString$ <> "" AND (NOT WildSearch) AND FailedSearch THEN _
GOTO 58187 _
ELSE GOTO 58168
58171 IF Category$ = "***" THEN _
GOTO 58176 _
ELSE HoldCat$ = "," + Category$ + "," : _
IF INSTR(Categories$,HoldCat$) > 0 THEN _
GOTO 58176 _
ELSE GOTO 58168
58172 LastOK = ZFalse
FailedSearch = ZFalse
LastFName = UpldIndex
IF Category$ = "***" THEN _
IF NOT ZSysop THEN _
GOTO 58178
IF Category$ = ZDefaultCatCode$ THEN _
IF BelowMinSec THEN _
GOTO 58178
58173 IF LEN(Categories$) > 2 THEN _
HoldCat$ = "," + _
Category$ + _
"," : _
CALL Remove (HoldCat$,Blank$) : _
IF INSTR(Categories$,HoldCat$) = 0 THEN _
GOTO 58178
IF ZJumpSearching OR SearchString$ <> "" THEN _
ZOutTxt$ = PartToPrint$ : _
IF WildSearch THEN _
Temp$ = LEFT$(PartToPrint$,INSTR(PartToPrint$," ")-1) : _
Temp$ = MID$(Temp$,1-(LEFT$(Temp$,1)="=")) : _
CALL WildFile (SearchString$,Temp$,ZOK) : _
IF ZOK THEN _
FoundString$ = SearchString$ : _
GOTO 58175 _
ELSE GOTO 58178 _
ELSE CALL AllCaps (ZOutTxt$) : _
HiLitePos = INSTR(ZOutTxt$,SearchFor$) : _
IF HiLitePos = 0 THEN _
FailedSearch = ZTrue : _
GOTO 58178 _
ELSE HiLiteRec = UpldIndex : _
FoundString$ = SearchFor$ : _
IF ZJumpSearching THEN _
ZJumpSearching = ZFalse : _
SearchFor$ = PrevSearch$
58174 IF SearchDate$ <> "" THEN _
HoldCat$ = MID$(PartToPrint$,25,2) + _
MID$(PartToPrint$,21,2) + _
MID$(PartToPrint$,23,2) : _
IF HoldCat$ < SearchDate$ THEN _
IF ZDateOrderedFMS THEN _
GOTO 58183 _
ELSE GOTO 58168
'
'
' * Allow the FMS to be both fast and interruptable if a local
' * user or there is nothing in the input buffer by using QuickTPut.
'
'
58175 LastOK = ZTrue
58176 ZWasA = EndDesc
IF LEFT$(PartToPrint$,5) = " " THEN _
GOTO 58178
ZOutTxt$ = PartToPrint$
CALL TrimTrail (ZOutTxt$," ")
CALL ColorDir (ZOutTxt$,"Y")
IF UpldIndex = HiLiteRec THEN _
HiLiteRec = -1 : _
HiLitePos = 0 : _
CALL CheckColor (ZOutTxt$,FoundString$,"")
58177 IF ZLocalUser THEN _
CALL QuickTPut1 (ZOutTxt$) : _
GOTO 58178
CALL EofComm (Char)
IF Char = -1 THEN _
CALL QuickTPut1 (ZOutTxt$) _
ELSE ZSubParm = 5 : _
CALL TPut : _
IF ZRet THEN _
GOTO 58183
58178 IF ZLinesPrinted <= MaxPrint AND FMSCheckPoint < 2000 THEN _
GOTO 58168
CALL CheckCarrier
IF ZSubParm = -1 THEN _
GOTO 58183
CALL TimeRemain (MinsRemaining)
IF MinsRemaining <= 0 THEN _
ZSubParm = -1 : _
GOTO 58183
IF ZNonStop THEN _
GOTO 58168
' IF ZLinesPrinted <= MaxPrint THEN _ ' Bh 082990
' CALL QuickTPut1 (ZEmphasizeOff$ + "Files have been searched back to " + MID$(PartToPrint$,21,6)) ' Bh 071190
IF ZLinesPrinted <= MaxPrint THEN _ ' Bh 082990
ZBobCount = ZBobCount + 2000 : _
CALL QuickTPut1 (ZEmphasizeOff$ + "I've searched " + STR$(ZBobCount) + " files, and there are more...") ' Bh 083090
58180 ZTurboKey = -ZTurboKeyUser
ZStackC = ZTrue
CALL AskMore (ExtraPrompt$, ZTrue, ZFalse,AbortIndex,ZFalse)
IF ZSubParm = -1 THEN _
GOTO 58183
IF ZNo THEN _
GOTO 58183
CALL AllCaps (ZUserIn$(1))
'
'Type TXT file mod Pe 10/21/89
'
IF ZUserIn$(1) = "+" THEN _
ZLastIndex = ZWasQ : _
ZAnsIndex = 1 : _
CALL TypeFile : _
ZwasA = UpldIndex : _
GOSUB 58185 : _
UpldIndex = ZwasA : _
GOTO 58180
'
IF ZUserIn$(1) = "V" THEN _
ZLastIndex = ZWasQ : _
ZAnsIndex = 1 : _
CALL GetArc : _
ZJumpSupported = ZTrue : _
ZWasA = UpldIndex : _
GOSUB 58185 : _
UpldIndex = ZWasA : _
GOTO 58180
IF ZUserIn$(1) = "D" THEN _
ZOutTxt$ = "Download which file(s)" : _ ' Bh
ZStackC = ZTrue : _
CALL PopCmdStack : _
IF ZWasQ = 0 THEN _
GOTO 58180
IF ZJumpSearching THEN _
PrevSearch$ = SearchFor$ : _
SearchFor$ = ZJumpTo$ _
ELSE SearchFor$ = SearchString$ : _
IF LEN(ZUserIn$(1)) > 1 THEN _
IF NOT ZYes AND CanDnld THEN _
CALL SkipLine (1) : _
DnldFlag = UpldIndex : _
ZLastIndex = ZWasQ : _
ZAnsIndex = 1 : _
EXIT SUB
IF ZNonStop THEN IF UpldIndex > 999 THEN _
IF (SearchDate$ = "" OR NOT ZExpertUser) THEN _
ZOutTxt$ = STR$(UpldIndex) + _
" lines left to search. Do you REALLY want to go non-stop? (Y/[N])" : _ ' Bh
ZNoAdvance = ZTrue : _
ZTurboKey = -ZTurboKeyUser : _
ZSubParm = 1 : _
CALL TGet : _
CALL WipeLine (79) : _
ZNonStop = ZYes
FMSCheckPoint = 0
GOTO 58168
58182 IF ZChainedDir$ <> "" THEN _
ZActiveFMSDir$ = ZChainedDir$ : _
GOSUB 58185 : _
GOTO 58168
58183 CLOSE 2
ZNonStop = (ZPageLength < 1)
ZStopInterrupts = ZFalse
ZOutTxt$ = ""
ZActiveFMSDir$ = "" ' KG031801
ZJumpSupported = ZFalse
EXIT SUB
58185 CALL OpenFMS (UpldIndex)
' EndDesc = 33 + ZMaxDescLen
EndDesc = 27 + ZMaxDescLen ' Bh 082790
FIELD 2, EndDesc AS PartToPrint$, _
3 AS Category$, _
2 AS Filler$
PrevFMS$ = ZActiveFMSDir$
IF ZUpInc = -1 THEN _
CutoffRec = 0 : _
UpldIndex = UpldIndex + 1 _
ELSE CutoffRec = UpldIndex + 1 : _
UpldIndex = 0
RETURN
58187 ZOutTxt$ = PartToPrint$
CALL AllCaps (ZOutTxt$)
HiLitePos = INSTR(ZOutTxt$,SearchFor$)
IF HiLitePos < 1 THEN _
GOTO 58168
HiLiteRec = UpldIndex
UpldIndex = LastFName
GET 2,UpldIndex
FoundString$ = SearchFor$
IF ZJumpSearching THEN _
SearchFor$ = PrevSearch$
GOTO 58175
END SUB
' $SUBTITLE: 'CONVERT2ZIP - subroutine to Convert to ZIP format'
' $PAGE
'
' NAME -- CONVERT2ZIP
'
' PARAMETERs WDR$ drive/subdir were file is located
' WZZ$ Filename (no Extension)
' WX$ extension of file being converted
' DESC$ file description for ZIP comment 'Pe 10/05/89
'
' PURPOSE -- Convert files to Zip format if remote user
'
SUB CONVERT2ZIP (WDR$,WZZ$,WX$,Desc$) STATIC 'Pe 10/05/89
IF WX$ = ".ZIP" THEN _
CALL QuickTPut (ZFileNameHold$ +" Now being verified and re-Zipped Please wait!",1) : _
WasZ$ = "PKUNZIP -x " + ZFileName$ + " " _
ELSE _
CALL QuickTPut (ZFileNameHold$ +" Now being converted to .ZIP format. Please wait!",1) : _
IF WX$ = ".ARC" OR WX$ = ".PAK" THEN _
WasZ$ = "PAK e " + ZFileName$ + " " : _
ELSE IF WX$ = ".LZH" THEN _
WasZ$ = "LHARC e " + ZFileName$ + " " : _
ELSE IF WX$ = ".ZOO" THEN _
WasZ$ = "ZOO.BAT " + ZFileName$ + " " : _
ELSE _
WasZ$ = "COPY " +ZFileName$ + " "
'
MplB$ = "CONVERT"+ZNodeID$+".BAT"
CALL OpenOutW (MplB$) : _
PRINT #2, "MD " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$
PRINT #2, "ECHO OFF"
IF NOT ZNetworkType = 4 THEN _ 'LK 02/24/90
PRINT #2, "CTTY GATE"+RIGHT$(ZComPort$,1)
PRINT #2, "SETERROR 0"
IF WX$ = ".LZH" THEN _
PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ +"\" _
ELSE _
PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$
PRINT #2, "DEL " + ZFileName$
PRINT #2, "SCAN "+ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ 'Pe 11/27/89
PRINT #2, "IF ERRORLEVEL 1 GOTO ERR "
PRINT #2, "PKZIP -m -ex " + WDR$ + WZZ$ + " " + _
ZLibWorkDiskPath$ + "WORK"+ZNodeID$ + "\*.*"
PRINT #2,":ERR"
IF NOT ZNetworkType = 4 THEN _ 'LK 02/24/90
PRINT #2, "CTTY CON"
PRINT #2, "KDY " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$
PRINT #2,"SETERROR 0"
PRINT #2, "ECHO ON"
PRINT #2, "EXIT"
IF ZUseDeviceDriver$ <> "" AND ZFossil AND ZNetworkType = 4 THEN _ 'LK 02/24/90
MplB$ = "COMMAND.COM /C "+ MplB$ + _ 'LK 02/24/90
" > " + _ 'LK 02/24/90
ZUseDeviceDriver$ _ 'LK 02/24/90
ELSE _ 'LK 02/24/90
MplB$ = "COMMAND.COM /C "+ MplB$ 'Pe 10/05/89
CALL ShellExit (MplB$) 'Pe 10/05/89
ZFileNameHold$ = WZZ$ + ".ZIP"
ZFileName$ = WDR$ + ZFileNameHold$
'
' *** adds BBS name , users name and description to Zip comment if succesfull
CALL FindIt (ZFileName$)
IF ZOK THEN
CLOSE 2
CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ + " .......",2)
CommentName$ =ZUpldSubDir$ +"\UPLOAD.CMT
ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
ADDCMT2$ = ZCrLf$ +"Description: " + Desc$
ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$
CALL OpenOutW (CommentName$)
PRINT #2, ADDCOMMENT$
CLOSE 2
ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$
SHELL "COMMAND.COM /C "+ADDCMT$
END IF
END SUB
'
'
' $SUBTITLE: 'LOCALCONVERT - subroutine to Convert to ZIP format'
' $PAGE
'
' NAME -- LOCALCONVERT
'
' PARAMETERs WDR$ drive/subdir were file is located
' WZZ$ Filename (no Extension)
' WX$ extension of file being converted
' DESC$ file description for ZIP comment 'Pe 10/05/89
'
' PURPOSE -- Convert files to Zip format if LOCAL user
'
SUB LOCALCONVERT (WDR$,WZZ$,WX$,Desc$) STATIC 'Pe 10/05/89
'
IF WX$ = ".ZIP" THEN _
CALL QuickTPut (ZFileNameHold$ +" Now being verified and re-Zipped Please wait!",1) : _
WasZ$ = "PKUNZIP -x " + ZFileName$ + " " _
ELSE _
CALL QuickTPut (ZFileNameHold$ +" Now being converted to .ZIP format. Please wait!",1) : _
IF WX$ = ".ARC" OR WX$ = ".PAK" THEN _
WasZ$ = "PAK e " + ZFileName$ + " " : _
ELSE IF WX$ = ".LZH" THEN _
WasZ$ = "LHARC e " + ZFileName$ + " " : _
ELSE IF WX$ = ".ZOO" THEN _
WasZ$ = "ZOO.BAT " + ZFileName$ + " " : _
ELSE _
WasZ$ = "COPY " +ZFileName$ + " "
'
MplB$ = "CONVERT"+ZNodeID$+".BAT"
CALL OpenOutW (MplB$) : _
PRINT #2, "MD " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$
IF WX$ = ".LZH" THEN _
PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ +"\" _
ELSE _
PRINT #2, WasZ$ + ZLibWorkDiskPath$ +"WORK"+ ZNodeID$
PRINT #2, "SCAN "+ZLibWorkDiskPath$ +"WORK"+ ZNodeID$ 'Pe 11/27/89
PRINT #2, "DEL " + ZFileName$
PRINT #2, "IF ERRORLEVEL 1 GOTO ERR "
PRINT #2, "PKZIP -m -ex " + WDR$ +WZZ$ + " " + _
ZLibWorkDiskPath$ + "WORK"+ZNodeID$ + "\*.*"
PRINT #2,":ERR"
PRINT #2, "KDY " + ZLibWorkDiskPath$ + "WORK"+ZNodeID$
PRINT #2,"SETERROR 0"
PRINT #2, "EXIT"
CLOSE 2
SHELL MplB$
ZFileNameHold$ = WZZ$ + ".ZIP"
ZFileName$ = WDR$ + ZFileNameHold$
CALL FindIt (ZFileName$)
IF ZOK THEN
CLOSE 2
CALL QuickTPut ("Adding Your Name and File Description to "+ZFileNameHold$ +" .......",2)
CommentName$ = ZUpldSubDir$ +"\UPLOAD.CMT
ADDCMT1$ =ZCrLf$ +"Uploaded to "+ ZRBBSName$ +" By: "+ZActiveUserName$
ADDCMT2$ = ZCrLf$ +"Description: " + Desc$
ADDCOMMENT$ = ADDCMT1$ + ADDCMT2$ + ZCrLf$
CALL OpenOutW (CommentName$)
PRINT #2, ADDCOMMENT$
CLOSE 2
ADDCMT$ = ZLibArcPath$+"PKZIP -z<"+CommentName$+" "+ ZFileName$
SHELL ADDCMT$
END IF
END SUB
'
'
'
' $SUBTITLE: 'TypeFile - subroutine to TYPE an ASCII FILE'
' $PAGE
'
' NAME -- TYPEAFILE
'
' PARAMETERs
'
'
'
'
' PURPOSE -- Type a ASCII file to screen
'
SUB TypeFile STATIC
59141 CALL SkipLine (1)
ZoutTxt$ = "Default Extension is .ZIP." + ZCrLf$ ' Bh
ZOutTxt$ = ZOutTxt$ + "File name for Extra Info"+ZPressEnterExpert$ ' Bh
CALL PopCmdStack
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
EXIT SUB
59142 ZViolation$ = "TYPE File"
WasX = ZAnsIndex
FOR ZAnsIndex = WasX TO ZLastIndex
GOSUB 59143
IF ZSubParm < 0 THEN _
ZAnsIndex = ZLastIndex + 1
NEXT ZAnsIndex
IF ZLastIndex > 1 THEN _
EXIT SUB _
ELSE GOTO 59141
59143 WasZ$ = ZUserIn$(ZAnsIndex)
CALL AllCaps (WasZ$)
IF INSTR(WasZ$,"*") OR INSTR(WasZ$,"?") THEN _
CALL QuickTPut ("Sorry, but Wildcards are NOT allowed !!",1) : _ ' Bh
RETURN
ZFileName$ = WasZ$
ZFileNameHold$ = WasZ$
CALL BadFile (ZFileNameHold$,BadFileNameIndex)
ON BadFileNameIndex GOTO 59145,59148,59150
59145 CALL BadName (BadFileNameIndex)
ON BadFileNameIndex GOTO 59146,59150
59146
dir$=LEFT$(ZFileName$,1)
WasZ$ = ZWelcomeFileDrvPath$ + "RBBSEXTR\" + dir$ + "\" + ZFileName$ ' EDit the Subdir/Drive for your Setup
CALL FindIt (WasZ$) ' checks to see if File really Exists
IF ZOK THEN _
GOTO 59158
'59146 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue,"V") 'Pe 02/25/90
' IF ZOK THEN _ ' Pe 02/06/90
' GOTO 59158
59148 WasZ$ = ZUserIn$(ZAnsIndex) + _
" has NO extra info! There needs to be a + next to the date." + ZCrLf$ ' Bh
' WasZ$ = WasZ$ + _
' "Did you give FULL FILENAME (including EXTENSION)?" + ZCrLf$ ' Bh
CALL UpdtCalr ("Couldn't find Extra Info on " + ZFileName$,1) 'DGS-014 ' Bh 091990
' CALL UpdtCalr (WasZ$,2)
ZOutTxt$ = WasZ$ + _
"Perhaps you misspelled. Try typing it again ([RETURN] to quit)" ' Bh
ZSubParm = 1
CALL TGet
IF ZSubParm = -1 OR ZWasQ = 0 THEN _
RETURN
ZUserIn$(ZAnsIndex) = ZUserIn$(1)
GOTO 59143
59150 CALL SecViolation
IF ZDenyAccess THEN _
EXIT SUB
GOTO 59148
59158 CALL BreakFileName (WasZ$,Drive$,Prefix$,Ext$,ZFalse)
IF Ext$ = "" THEN _
GOTO 59160
IF INSTR("DAT,BIN,",Ext$+",") > 0 THEN _
CALL QuickTPut ("Wrong format; I can't display info on files with " +Ext$ + " extensions",1) : _ ' Bh
RETURN
59160 CALL BufFile (WasZ$,WasX)
CALL UpdtCalr ("Read Extra Info on " + ZFileName$,1) 'DGS-014 ' Bh 091990
' 59160 CALL BufFile ("E:\DES\"+ZFileName$) ' Bh 06/25/90
RETURN
END SUB